Initial switch to new trifecta-based parser
Still several bugs to work out
This commit is contained in:
Gabriel Gonzalez
parent
0534b79ca5
commit
13eddef662
|
|
@ -36,6 +36,7 @@ Library
|
|||
Hs-Source-Dirs: src
|
||||
Build-Depends:
|
||||
base >= 4 && < 5 ,
|
||||
ansi-wl-pprint,
|
||||
array >= 0.4.0.0 && < 0.6 ,
|
||||
bytestring < 0.11,
|
||||
bytestring-lexing >= 0.5.0.2 && < 0.6 ,
|
||||
|
|
|
|||
19
exec/Main.hs
19
exec/Main.hs
|
|
@ -5,12 +5,11 @@ import Data.Monoid (mempty)
|
|||
import Data.Traversable
|
||||
import Dhall.Core (pretty, normalize)
|
||||
import Dhall.Import (load)
|
||||
import Dhall.Parser (exprFromBytes)
|
||||
import Dhall.Parser2 (exprFromText)
|
||||
import Options.Applicative hiding (Const)
|
||||
import System.IO (stderr)
|
||||
import System.Exit (exitFailure)
|
||||
|
||||
import qualified Data.ByteString.Lazy
|
||||
import qualified Data.Text.Lazy.IO
|
||||
import qualified Dhall.TypeCheck
|
||||
|
||||
|
|
@ -72,21 +71,21 @@ main = do
|
|||
)
|
||||
case mode of
|
||||
Default -> do
|
||||
inBytes <- Data.ByteString.Lazy.getContents
|
||||
expr <- throws (exprFromBytes inBytes)
|
||||
inText <- Data.Text.Lazy.IO.getContents
|
||||
expr <- throws (exprFromText inText)
|
||||
expr' <- load Nothing expr
|
||||
typeExpr <- throws (Dhall.TypeCheck.typeOf expr')
|
||||
Data.Text.Lazy.IO.hPutStrLn stderr (pretty (normalize typeExpr))
|
||||
Data.Text.Lazy.IO.hPutStrLn stderr mempty
|
||||
Data.Text.Lazy.IO.putStrLn (pretty (normalize expr'))
|
||||
Resolve -> do
|
||||
inBytes <- Data.ByteString.Lazy.getContents
|
||||
expr <- throws (exprFromBytes inBytes)
|
||||
inText <- Data.Text.Lazy.IO.getContents
|
||||
expr <- throws (exprFromText inText)
|
||||
expr' <- load Nothing expr
|
||||
Data.Text.Lazy.IO.putStrLn (pretty expr')
|
||||
TypeCheck -> do
|
||||
inBytes <- Data.ByteString.Lazy.getContents
|
||||
expr <- throws (exprFromBytes inBytes)
|
||||
inText <- Data.Text.Lazy.IO.getContents
|
||||
expr <- throws (exprFromText inText)
|
||||
case traverse (\_ -> Nothing) expr of
|
||||
Nothing -> throwIO (userError
|
||||
"`dhall typecheck` cannot type-check a program containing \
|
||||
|
|
@ -97,6 +96,6 @@ main = do
|
|||
typeExpr <- throws (Dhall.TypeCheck.typeOf expr')
|
||||
Data.Text.Lazy.IO.putStrLn (pretty typeExpr)
|
||||
Normalize -> do
|
||||
inBytes <- Data.ByteString.Lazy.getContents
|
||||
expr <- throws (exprFromBytes inBytes)
|
||||
inText <- Data.Text.Lazy.IO.getContents
|
||||
expr <- throws (exprFromText inText)
|
||||
Data.Text.Lazy.IO.putStrLn (pretty (normalize expr))
|
||||
|
|
|
|||
11
src/Dhall.hs
11
src/Dhall.hs
|
|
@ -314,11 +314,10 @@ module Dhall
|
|||
|
||||
import Control.Applicative (empty, liftA2, (<|>))
|
||||
import Control.Exception (Exception)
|
||||
import Data.ByteString.Lazy (ByteString)
|
||||
import Data.Text.Lazy (Text)
|
||||
import Data.Vector (Vector)
|
||||
import Dhall.Core (Expr(..))
|
||||
import Dhall.Parser (Src)
|
||||
import Dhall.Parser2 (Src)
|
||||
import Dhall.TypeCheck (X)
|
||||
import GHC.Generics
|
||||
import Numeric.Natural (Natural)
|
||||
|
|
@ -331,7 +330,7 @@ import qualified Data.Text.Lazy.Builder
|
|||
import qualified Data.Vector
|
||||
import qualified Dhall.Core
|
||||
import qualified Dhall.Import
|
||||
import qualified Dhall.Parser
|
||||
import qualified Dhall.Parser2
|
||||
import qualified Dhall.TypeCheck
|
||||
import qualified GHC.Generics
|
||||
|
||||
|
|
@ -357,12 +356,12 @@ True
|
|||
input
|
||||
:: Type a
|
||||
-- ^ The type of value to decode from Dhall to Haskell
|
||||
-> ByteString
|
||||
-> Text
|
||||
-- ^ The Dhall program
|
||||
-> IO a
|
||||
-- ^ The decoded value in Haskell
|
||||
input (Type {..}) bytes = do
|
||||
expr <- throws (Dhall.Parser.exprFromBytes bytes)
|
||||
input (Type {..}) text = do
|
||||
expr <- throws (Dhall.Parser2.exprFromText text)
|
||||
expr' <- Dhall.Import.load Nothing expr
|
||||
typeExpr <- throws (Dhall.TypeCheck.typeOf (Annot expr' expected))
|
||||
case extract (Dhall.Core.normalize expr') of
|
||||
|
|
|
|||
|
|
@ -424,10 +424,9 @@ buildText a = build (show a)
|
|||
|
||||
-- | Builder corresponding to the @Expr0@ parser in "Dhall.Parser"
|
||||
buildExpr0 :: Buildable a => Expr s a -> Builder
|
||||
buildExpr0 (Annot a b) =
|
||||
buildExpr1 a <> " : " <> buildExpr0 b
|
||||
buildExpr0 a =
|
||||
buildExpr1 a
|
||||
buildExpr0 (Annot a b) = buildExpr1 a <> " : " <> buildExpr0 b
|
||||
buildExpr0 (Note _ b) = buildExpr0 b
|
||||
buildExpr0 a = buildExpr1 a
|
||||
|
||||
-- | Builder corresponding to the @Expr1@ parser in "Dhall.Parser"
|
||||
buildExpr1 :: Buildable a => Expr s a -> Builder
|
||||
|
|
@ -492,6 +491,8 @@ buildExpr1 (MaybeLit a b) =
|
|||
"[" <> buildElems (Data.Vector.toList b) <> "] : Maybe " <> buildExpr6 a
|
||||
buildExpr1 (Apply a b c) =
|
||||
"apply " <> buildExpr6 a <> " " <> buildExpr6 b <> " : " <> buildExpr5 c
|
||||
buildExpr1 (Note _ b) =
|
||||
buildExpr1 b
|
||||
buildExpr1 a =
|
||||
buildExpr2 a
|
||||
|
||||
|
|
@ -499,6 +500,7 @@ buildExpr1 a =
|
|||
buildExpr2 :: Buildable a => Expr s a -> Builder
|
||||
buildExpr2 (BoolEQ a b) = buildExpr2 a <> " == " <> buildExpr2 b
|
||||
buildExpr2 (BoolNE a b) = buildExpr2 a <> " /= " <> buildExpr2 b
|
||||
buildExpr2 (Note _ b) = buildExpr2 b
|
||||
buildExpr2 a = buildExpr3 a
|
||||
|
||||
-- | Builder corresponding to the @Expr3@ parser in "Dhall.Parser"
|
||||
|
|
@ -506,6 +508,7 @@ buildExpr3 :: Buildable a => Expr s a -> Builder
|
|||
buildExpr3 (BoolOr a b) = buildExpr3 a <> " || " <> buildExpr3 b
|
||||
buildExpr3 (NaturalPlus a b) = buildExpr3 a <> " + " <> buildExpr3 b
|
||||
buildExpr3 (TextAppend a b) = buildExpr3 a <> " ++ " <> buildExpr3 b
|
||||
buildExpr3 (Note _ b) = buildExpr3 b
|
||||
buildExpr3 a = buildExpr4 a
|
||||
|
||||
-- | Builder corresponding to the @Expr4@ parser in "Dhall.Parser"
|
||||
|
|
@ -513,12 +516,14 @@ buildExpr4 :: Buildable a => Expr s a -> Builder
|
|||
buildExpr4 (BoolAnd a b) = buildExpr4 a <> " && " <> buildExpr4 b
|
||||
buildExpr4 (NaturalTimes a b) = buildExpr4 a <> " * " <> buildExpr4 b
|
||||
buildExpr4 (Merge a b) = buildExpr4 a <> " ∧ " <> buildExpr4 b
|
||||
buildExpr4 (Note _ b) = buildExpr4 b
|
||||
buildExpr4 a = buildExpr5 a
|
||||
|
||||
-- | Builder corresponding to the @Expr5@ parser in "Dhall.Parser"
|
||||
buildExpr5 :: Buildable a => Expr s a -> Builder
|
||||
buildExpr5 (App a b) = buildExpr5 a <> " " <> buildExpr6 b
|
||||
buildExpr5 a = buildExpr6 a
|
||||
buildExpr5 (App a b) = buildExpr5 a <> " " <> buildExpr6 b
|
||||
buildExpr5 (Note _ b) = buildExpr5 b
|
||||
buildExpr5 a = buildExpr6 a
|
||||
|
||||
-- | Builder corresponding to the @Expr6@ parser in "Dhall.Parser"
|
||||
buildExpr6 :: Buildable a => Expr s a -> Builder
|
||||
|
|
@ -590,6 +595,8 @@ buildExpr6 (Embed a) =
|
|||
build a
|
||||
buildExpr6 (Field a b) =
|
||||
buildExpr6 a <> "." <> buildLabel b
|
||||
buildExpr6 (Note _ b) =
|
||||
buildExpr6 b
|
||||
buildExpr6 a =
|
||||
"(" <> buildExpr0 a <> ")"
|
||||
|
||||
|
|
|
|||
|
|
@ -96,19 +96,19 @@ import Filesystem as Filesystem
|
|||
import Lens.Micro (Lens')
|
||||
import Lens.Micro.Mtl (zoom)
|
||||
import Dhall.Core (Expr, Path(..))
|
||||
import Dhall.Parser (Src)
|
||||
import Dhall.Parser2 (Src)
|
||||
import Dhall.TypeCheck (X(..))
|
||||
import Network.HTTP.Client (Manager)
|
||||
import Prelude hiding (FilePath)
|
||||
|
||||
import qualified Control.Monad.Trans.State.Strict as State
|
||||
import qualified Data.ByteString.Lazy as ByteString
|
||||
import qualified Data.Foldable as Foldable
|
||||
import qualified Data.List as List
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Text.Lazy as Text
|
||||
import qualified Data.Text.Lazy.Builder as Builder
|
||||
import qualified Dhall.Parser
|
||||
import qualified Data.Text.Lazy.Encoding
|
||||
import qualified Dhall.Parser2
|
||||
import qualified Dhall.TypeCheck
|
||||
import qualified Network.HTTP.Client as HTTP
|
||||
import qualified Network.HTTP.Client.TLS as HTTP
|
||||
|
|
@ -318,11 +318,12 @@ loadDynamic p = do
|
|||
`onException` throwIO (Imported paths e)
|
||||
_ -> throwIO (Imported paths e) )
|
||||
response <- liftIO httpLbs'
|
||||
return (HTTP.responseBody response)
|
||||
let bytes = HTTP.responseBody response
|
||||
return (Data.Text.Lazy.Encoding.decodeUtf8 bytes)
|
||||
|
||||
let readFile' file = liftIO (do
|
||||
(do bytes <- Filesystem.readFile file
|
||||
return (ByteString.fromStrict bytes) ) `catch` (\e -> do
|
||||
(do text <- Filesystem.readTextFile file
|
||||
return (Text.fromStrict text) ) `catch` (\e -> do
|
||||
-- Unfortunately, GHC throws an `InappropriateType`
|
||||
-- exception when trying to read a directory, but does not
|
||||
-- export the exception, so I must resort to a more
|
||||
|
|
@ -331,16 +332,16 @@ loadDynamic p = do
|
|||
-- If the fallback fails, reuse the original exception to
|
||||
-- avoid user confusion
|
||||
let file' = file </> "@"
|
||||
bytes <- Filesystem.readFile file'
|
||||
text <- Filesystem.readTextFile file'
|
||||
`onException` throwIO (Imported paths e)
|
||||
return (ByteString.fromStrict bytes) ) )
|
||||
return (Text.fromStrict text) ) )
|
||||
|
||||
bytes <- case canonicalize (p:paths) of
|
||||
File file -> readFile' file
|
||||
URL url -> readURL url
|
||||
|
||||
let abort err = liftIO (throwIO (Imported (p:paths) err))
|
||||
case Dhall.Parser.exprFromBytes bytes of
|
||||
case Dhall.Parser2.exprFromText bytes of
|
||||
Left err -> case canonicalize (p:paths) of
|
||||
URL url -> do
|
||||
-- Also try the fallback in case of a parse error, since the
|
||||
|
|
@ -351,7 +352,10 @@ loadDynamic p = do
|
|||
m <- needManager
|
||||
response <- liftIO
|
||||
(HTTP.httpLbs request' m `onException` abort err)
|
||||
case Dhall.Parser.exprFromBytes (HTTP.responseBody response) of
|
||||
-- TODO: Handle UTF8 decoding errors
|
||||
let bytes' = HTTP.responseBody response
|
||||
let text = Data.Text.Lazy.Encoding.decodeUtf8 bytes'
|
||||
case Dhall.Parser2.exprFromText text of
|
||||
Left _ -> liftIO (abort err)
|
||||
Right expr -> return expr
|
||||
_ -> liftIO (abort err)
|
||||
|
|
|
|||
|
|
@ -1,24 +1,38 @@
|
|||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Dhall.Parser2 where
|
||||
{-
|
||||
module Dhall.Parser2 (
|
||||
-- * Parser
|
||||
exprFromText
|
||||
|
||||
import Control.Applicative (Alternative(..))
|
||||
-- * Types
|
||||
, Src(..)
|
||||
, ParseError(..)
|
||||
) where
|
||||
-}
|
||||
|
||||
import Control.Applicative (Alternative(..), optional)
|
||||
import Control.Exception (Exception)
|
||||
import Control.Monad (MonadPlus)
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Map (Map)
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Text.Lazy (Text)
|
||||
import Data.Typeable (Typeable)
|
||||
import Data.Vector (Vector)
|
||||
import Dhall.Core (Const(..), Expr(..), Path(..), Var(..))
|
||||
import Filesystem.Path (FilePath)
|
||||
import Prelude hiding (FilePath, const)
|
||||
import Text.Parser.Combinators (try)
|
||||
import Prelude hiding (FilePath, const, pi)
|
||||
import Text.PrettyPrint.ANSI.Leijen (Doc)
|
||||
import Text.Parser.Combinators (choice, try)
|
||||
import Text.Parser.Expression (Assoc(..), Operator(..))
|
||||
import Text.Parser.Token (IdentifierStyle(..), TokenParsing(..))
|
||||
import Text.Parser.Token.Highlight (Highlight(..))
|
||||
import Text.Parser.Token.Style (CommentStyle(..))
|
||||
import Text.Trifecta (CharParsing, DeltaParsing, Parsing)
|
||||
import Text.Trifecta (CharParsing, DeltaParsing, Parsing, Result(..))
|
||||
import Text.Trifecta.Delta (Delta)
|
||||
|
||||
import qualified Data.Char
|
||||
|
|
@ -63,12 +77,17 @@ instance TokenParsing Parser where
|
|||
|
||||
highlight h (Parser m) = Parser (highlight h m)
|
||||
|
||||
token parser = do
|
||||
r <- parser
|
||||
Text.Parser.Token.whiteSpace
|
||||
return r
|
||||
|
||||
identifierStyle :: IdentifierStyle Parser
|
||||
identifierStyle = IdentifierStyle
|
||||
{ _styleName = "dhall"
|
||||
-- TODO: Restrict start and letter to ASCII letters
|
||||
, _styleStart = Text.Parser.Char.letter <|> Text.Parser.Char.char '_'
|
||||
, _styleLetter = Text.Parser.Char.alphaNum <|> Text.Parser.Char.oneOf "_\\"
|
||||
, _styleLetter = Text.Parser.Char.alphaNum <|> Text.Parser.Char.oneOf "_/"
|
||||
, _styleReserved = Data.HashSet.fromList
|
||||
-- TODO: Ensure that this list is complete
|
||||
[ "let"
|
||||
|
|
@ -76,6 +95,7 @@ identifierStyle = IdentifierStyle
|
|||
, "Type"
|
||||
, "Kind"
|
||||
, "forall"
|
||||
, "∀"
|
||||
, "Bool"
|
||||
, "True"
|
||||
, "False"
|
||||
|
|
@ -114,14 +134,22 @@ noted parser = do
|
|||
after <- Text.Trifecta.position
|
||||
return (Note (Src before after bytes) expr)
|
||||
|
||||
reserve :: String -> Parser ()
|
||||
reserve string = do
|
||||
_ <- Text.Parser.Token.reserve identifierStyle string
|
||||
return ()
|
||||
|
||||
symbol :: String -> Parser ()
|
||||
symbol string = do
|
||||
_ <- Text.Parser.Token.reserve identifierStyle string
|
||||
_ <- Text.Parser.Token.symbol string
|
||||
return ()
|
||||
|
||||
lambda :: Parser ()
|
||||
lambda = symbol "\\" <|> symbol "λ"
|
||||
|
||||
pi :: Parser ()
|
||||
pi = reserve "forall" <|> reserve "∀"
|
||||
|
||||
arrow :: Parser ()
|
||||
arrow = symbol "->" <|> symbol "→"
|
||||
|
||||
|
|
@ -132,10 +160,8 @@ label :: Parser Text
|
|||
label = Text.Parser.Token.ident identifierStyle
|
||||
|
||||
exprA :: Parser (Expr Src Path)
|
||||
exprA = noted
|
||||
( try exprA0
|
||||
)
|
||||
<|> exprA1
|
||||
exprA = noted (try exprA0)
|
||||
<|> exprA1
|
||||
where
|
||||
exprA0 = do
|
||||
a <- exprB
|
||||
|
|
@ -146,17 +172,17 @@ exprA = noted
|
|||
exprA1 = exprB
|
||||
|
||||
exprB :: Parser (Expr Src Path)
|
||||
exprB = noted
|
||||
( try exprB0
|
||||
<|> try exprB1
|
||||
<|> try exprB2
|
||||
<|> try exprB3
|
||||
<|> try exprB4
|
||||
<|> try exprB5
|
||||
<|> try exprB6
|
||||
<|> try exprB7
|
||||
)
|
||||
<|> exprB8
|
||||
exprB = choice
|
||||
[ noted (try exprB0)
|
||||
, noted (try exprB1)
|
||||
, noted (try exprB2)
|
||||
, noted (try exprB3)
|
||||
, noted (try exprB4)
|
||||
, noted (try exprB5)
|
||||
, noted (try exprB6)
|
||||
, noted (try exprB7)
|
||||
, exprB8
|
||||
]
|
||||
where
|
||||
exprB0 = do
|
||||
lambda
|
||||
|
|
@ -170,11 +196,11 @@ exprB = noted
|
|||
return (Lam a b c)
|
||||
|
||||
exprB1 = do
|
||||
symbol "if"
|
||||
reserve "if"
|
||||
a <- exprA
|
||||
symbol "then"
|
||||
reserve "then"
|
||||
b <- exprB
|
||||
symbol "else"
|
||||
reserve "else"
|
||||
c <- exprC
|
||||
return (BoolIf a b c)
|
||||
|
||||
|
|
@ -185,32 +211,33 @@ exprB = noted
|
|||
return (Pi "_" a b)
|
||||
|
||||
exprB3 = do
|
||||
symbol "forall"
|
||||
pi
|
||||
symbol "("
|
||||
a <- label
|
||||
symbol ":"
|
||||
b <- exprA
|
||||
symbol ")"
|
||||
arrow
|
||||
c <- exprB
|
||||
return (Pi a b c)
|
||||
|
||||
exprB4 = do
|
||||
symbol "let"
|
||||
reserve "let"
|
||||
a <- label
|
||||
symbol "="
|
||||
b <- exprA
|
||||
symbol "in"
|
||||
reserve "in"
|
||||
c <- exprB
|
||||
return (Let a Nothing b c)
|
||||
|
||||
exprB5 = do
|
||||
symbol "let"
|
||||
reserve "let"
|
||||
a <- label
|
||||
symbol ":"
|
||||
b <- exprA
|
||||
symbol "="
|
||||
c <- exprA
|
||||
symbol "in"
|
||||
reserve "in"
|
||||
d <- exprB
|
||||
return (Let a (Just b) c d)
|
||||
|
||||
|
|
@ -224,7 +251,7 @@ exprB = noted
|
|||
return (b c (Data.Vector.fromList a))
|
||||
|
||||
exprB7 = do
|
||||
symbol "apply"
|
||||
reserve "apply"
|
||||
a <- exprE
|
||||
b <- exprE
|
||||
symbol ":"
|
||||
|
|
@ -240,11 +267,11 @@ listLike =
|
|||
)
|
||||
where
|
||||
listLike0 = do
|
||||
symbol "List"
|
||||
reserve "List"
|
||||
return ListLit
|
||||
|
||||
listLike1 = do
|
||||
symbol "Maybe"
|
||||
reserve "Maybe"
|
||||
return MaybeLit
|
||||
|
||||
-- TODO: Add `noted` in the right places here
|
||||
|
|
@ -276,40 +303,40 @@ exprD = do
|
|||
|
||||
exprE :: Parser (Expr Src Path)
|
||||
exprE = noted
|
||||
( exprE00
|
||||
<|> exprE01
|
||||
<|> exprE02
|
||||
<|> exprE03
|
||||
<|> exprE04
|
||||
<|> exprE05
|
||||
<|> exprE06
|
||||
<|> exprE07
|
||||
<|> exprE08
|
||||
<|> exprE09
|
||||
<|> exprE10
|
||||
<|> exprE11
|
||||
<|> exprE12
|
||||
<|> exprE13
|
||||
<|> exprE14
|
||||
<|> exprE15
|
||||
<|> exprE16
|
||||
<|> exprE17
|
||||
<|> exprE18
|
||||
<|> exprE19
|
||||
<|> exprE20
|
||||
<|> exprE21
|
||||
<|> exprE22
|
||||
<|> exprE23
|
||||
<|> exprE24
|
||||
<|> exprE25
|
||||
<|> exprE26
|
||||
<|> exprE27
|
||||
<|> exprE28
|
||||
<|> exprE29
|
||||
<|> exprE30
|
||||
<|> exprE31
|
||||
-- <|> exprE32
|
||||
<|> exprE33
|
||||
( try exprE01
|
||||
<|> try exprE03
|
||||
<|> try exprE04
|
||||
<|> try exprE05
|
||||
<|> try exprE06
|
||||
<|> try exprE12
|
||||
<|> try exprE13
|
||||
<|> try exprE14
|
||||
<|> try exprE15
|
||||
<|> try exprE16
|
||||
<|> try exprE17
|
||||
<|> try exprE18
|
||||
<|> try exprE19
|
||||
<|> try exprE20
|
||||
<|> try exprE21
|
||||
<|> try exprE22
|
||||
<|> try exprE23
|
||||
<|> try exprE24
|
||||
<|> try exprE25
|
||||
<|> try exprE26
|
||||
<|> try exprE27
|
||||
<|> try exprE28
|
||||
<|> try exprE29
|
||||
<|> try exprE30
|
||||
<|> try exprE31
|
||||
-- <|> try exprE32
|
||||
<|> try exprE02
|
||||
<|> try exprE07
|
||||
<|> try exprE08
|
||||
<|> try exprE09
|
||||
<|> try exprE10
|
||||
<|> try exprE11
|
||||
<|> try exprE00
|
||||
<|> exprE33
|
||||
)
|
||||
where
|
||||
exprE00 = do
|
||||
|
|
@ -321,87 +348,87 @@ exprE = noted
|
|||
return (Const a)
|
||||
|
||||
exprE02 = do
|
||||
symbol "Natural"
|
||||
reserve "Natural"
|
||||
return Natural
|
||||
|
||||
exprE03 = do
|
||||
symbol "Natural/fold"
|
||||
reserve "Natural/fold"
|
||||
return NaturalFold
|
||||
|
||||
exprE04 = do
|
||||
symbol "Natural/build"
|
||||
reserve "Natural/build"
|
||||
return NaturalBuild
|
||||
|
||||
exprE05 = do
|
||||
symbol "Natural/isZero"
|
||||
reserve "Natural/isZero"
|
||||
return NaturalIsZero
|
||||
|
||||
exprE06 = do
|
||||
symbol "Natural/even"
|
||||
reserve "Natural/even"
|
||||
return NaturalEven
|
||||
|
||||
exprE07 = do
|
||||
symbol "Natural/odd"
|
||||
reserve "Natural/odd"
|
||||
return NaturalOdd
|
||||
|
||||
exprE08 = do
|
||||
symbol "Integer"
|
||||
reserve "Integer"
|
||||
return Integer
|
||||
|
||||
exprE09 = do
|
||||
symbol "Double"
|
||||
reserve "Double"
|
||||
return Double
|
||||
|
||||
exprE10 = do
|
||||
symbol "Text"
|
||||
reserve "Text"
|
||||
return Text
|
||||
|
||||
exprE11 = do
|
||||
symbol "List"
|
||||
reserve "List"
|
||||
return List
|
||||
|
||||
exprE12 = do
|
||||
symbol "List/build"
|
||||
reserve "List/build"
|
||||
return ListBuild
|
||||
|
||||
exprE13 = do
|
||||
symbol "List/fold"
|
||||
reserve "List/fold"
|
||||
return ListFold
|
||||
|
||||
exprE14 = do
|
||||
symbol "List/length"
|
||||
reserve "List/length"
|
||||
return ListLength
|
||||
|
||||
exprE15 = do
|
||||
symbol "List/head"
|
||||
reserve "List/head"
|
||||
return ListHead
|
||||
|
||||
exprE16 = do
|
||||
symbol "List/last"
|
||||
reserve "List/last"
|
||||
return ListLast
|
||||
|
||||
exprE17 = do
|
||||
symbol "List/indexed"
|
||||
reserve "List/indexed"
|
||||
return ListIndexed
|
||||
|
||||
exprE18 = do
|
||||
symbol "List/reverse"
|
||||
reserve "List/reverse"
|
||||
return ListReverse
|
||||
|
||||
exprE19 = do
|
||||
symbol "Maybe"
|
||||
reserve "Maybe"
|
||||
return Maybe
|
||||
|
||||
exprE20 = do
|
||||
symbol "Maybe/fold"
|
||||
reserve "Maybe/fold"
|
||||
return MaybeFold
|
||||
|
||||
exprE21 = do
|
||||
symbol "True"
|
||||
reserve "True"
|
||||
return (BoolLit True)
|
||||
|
||||
exprE22 = do
|
||||
symbol "False"
|
||||
reserve "False"
|
||||
return (BoolLit False)
|
||||
|
||||
exprE23 = do
|
||||
|
|
@ -450,16 +477,16 @@ const = const0
|
|||
<|> const1
|
||||
where
|
||||
const0 = do
|
||||
symbol "Type"
|
||||
reserve "Type"
|
||||
return Type
|
||||
|
||||
const1 = do
|
||||
symbol "Kind"
|
||||
reserve "Kind"
|
||||
return Kind
|
||||
|
||||
var :: Parser Var
|
||||
var = var0
|
||||
<|> var1
|
||||
var = try var0
|
||||
<|> var1
|
||||
where
|
||||
var0 = do
|
||||
a <- label
|
||||
|
|
@ -490,7 +517,8 @@ recordLit =
|
|||
return (RecordLit (Data.Map.fromList a))
|
||||
|
||||
fieldValues :: Parser [(Text, Expr Src Path)]
|
||||
fieldValues = Text.Parser.Combinators.sepBy1 fieldValue (symbol ",")
|
||||
fieldValues =
|
||||
Text.Parser.Combinators.sepBy1 fieldValue (symbol ",")
|
||||
|
||||
fieldValue :: Parser (Text, Expr Src Path)
|
||||
fieldValue = do
|
||||
|
|
@ -507,7 +535,8 @@ record = do
|
|||
return (Record (Data.Map.fromList a))
|
||||
|
||||
fieldTypes :: Parser [(Text, Expr Src Path)]
|
||||
fieldTypes = Text.Parser.Combinators.sepBy fieldType (symbol ",")
|
||||
fieldTypes =
|
||||
Text.Parser.Combinators.sepBy fieldType (symbol ",")
|
||||
|
||||
fieldType :: Parser (Text, Expr Src Path)
|
||||
fieldType = do
|
||||
|
|
@ -524,7 +553,8 @@ union = do
|
|||
return (Union (Data.Map.fromList a))
|
||||
|
||||
alternativeTypes :: Parser [(Text, Expr Src Path)]
|
||||
alternativeTypes = Text.Parser.Combinators.sepBy alternativeType (symbol "|")
|
||||
alternativeTypes =
|
||||
Text.Parser.Combinators.sepBy alternativeType (symbol "|")
|
||||
|
||||
alternativeType :: Parser (Text, Expr Src Path)
|
||||
alternativeType = do
|
||||
|
|
@ -602,3 +632,29 @@ url = url0
|
|||
a <- Text.Parser.Char.string "http://"
|
||||
b <- many (Text.Parser.Char.satisfy (not . Data.Char.isSpace))
|
||||
return (Data.Text.Lazy.pack (a <> b))
|
||||
|
||||
-- | A parsing error
|
||||
newtype ParseError = ParseError Doc deriving (Typeable)
|
||||
|
||||
instance Show ParseError where
|
||||
show (ParseError doc) = show doc
|
||||
|
||||
instance Exception ParseError
|
||||
|
||||
-- TODO: Support parsing from file for better error messages
|
||||
|
||||
-- | Parse an expression from `Text` containing a Dhall program program
|
||||
exprFromText :: Text -> Either ParseError (Expr Src Path)
|
||||
exprFromText text = case result of
|
||||
Success r -> Right r
|
||||
Failure errInfo -> Left (ParseError (Text.Trifecta._errDoc errInfo))
|
||||
where
|
||||
string = Data.Text.Lazy.unpack text
|
||||
|
||||
parser = do
|
||||
Text.Parser.Token.whiteSpace
|
||||
r <- unParser exprA
|
||||
Text.Parser.Combinators.eof
|
||||
return r
|
||||
|
||||
result = Text.Trifecta.parseString parser mempty string
|
||||
|
|
|
|||
|
|
@ -476,9 +476,9 @@ typeWith ctx e@(Field r x ) = do
|
|||
Nothing -> Left (TypeError ctx e (MissingField x t))
|
||||
_ -> Left (TypeError ctx e (NotARecord x r t))
|
||||
typeWith ctx (Note s e' ) = case typeWith ctx e' of
|
||||
Left (TypeError ctx' (Note _ e'') m) -> Left (TypeError ctx' (Note s e'') m)
|
||||
-- Left (TypeError ctx' (Note _ e'') m) -> Left (TypeError ctx' (Note s e'') m)
|
||||
Left (TypeError ctx' e'' m) -> Left (TypeError ctx' (Note s e'') m)
|
||||
Right r -> Right r
|
||||
Right r -> Right r
|
||||
typeWith _ (Embed p ) = do
|
||||
absurd p
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user