----------------------------------------------------------------
Name: dyna
-Version: 0.3.5
-Cabal-Version: >= 1.14
+Version: 0.4
+Cabal-Version: >=1.14
Build-Type: Simple
Stability: alpha
Copyright: Copyright (c) 2007--2012,
Default-Language: Haskell2010
Hs-Source-Dirs: src
- Exposed-Modules: Dyna.ParserHS.Parser
+ ghc-options: -Wall
+
+ Exposed-Modules: Dyna.ParserHS.Parser,
+ Dyna.NormalizeParse,
+ Dyna.XXX.Trifecta
Build-Depends: base >=4,
- bytestring >= 0.9,
+ bytestring >=0.9,
+ containers >=0.4,
+ mtl >=2.1,
+ reducers >=3.0,
semigroups >=0.8,
trifecta >=0.53,
unification-fd,
unordered-containers>=0.2,
utf8-string >=0.3
+Executable drepl
+ Default-Language: Haskell2010
+
+ ghc-options: -Wall
+
+ Hs-Source-Dirs: src
+ Build-Depends: base >=4,
+ bytestring >=0.9,
+ containers >=0.4,
+ editline >=0.2,
+ reducers >=3.0,
+ semigroups >=0.8,
+ trifecta >=0.53,
+ unordered-containers>=0.2,
+ utf8-string >=0.3
+
+ Main-Is: Dyna/REPL.hs
+
Test-suite dyna-selftest-parser
type: exitcode-stdio-1.0
Default-Language: Haskell2010
Hs-Source-Dirs: src
- Build-Depends: base >= 4,
+ Build-Depends: base >=4,
bytestring >=0.9,
containers >=0.4,
HUnit >=1.2,
+ reducers >=3.0,
semigroups >=0.8,
test-framework >=0.6,
- test-framework-hunit >= 0.2,
- test-framework-th >= 0.2,
+ test-framework-hunit >=0.2,
+ test-framework-th >=0.2,
trifecta >=0.53,
unordered-containers>=0.2,
utf8-string >=0.3
Main-Is: Dyna/ParserHS/ParserSelftest.hs
+
----------------------------------------------------------------
----------------------------------------------------------- fin.
import qualified Text.Trifecta as T
import qualified Dyna.ParserHS.Parser as P
-import Dyna.Test.Trifecta -- XXX
+-- import Dyna.Test.Trifecta -- XXX
data Term = TFunctor !B.ByteString ![Term]
| TVar !B.ByteString
flip runReaderT (AD dynaFunctorArgDispositions dynaFunctorSelfDispositions)
-- XXX
-testNormTerm = run . normalizeTerm False . unsafeParse P.dterm
+-- testNormTerm = run . normalizeTerm False . unsafeParse P.dterm
normalizeRule (P.Fact t T.:~ _) = do
nt <- normalizeTerm False t
nes <- mapM (normalizeTerm True) es
return $ Rule nh a nes nr
-testNormRule = run . normalizeRule . unsafeParse P.drule
+-- testNormRule = run . normalizeRule . unsafeParse P.drule
{-
neis e = newEval "_normE_" $ \v -> EIs v e
]
dline :: MonadParser m => m (Spanned Line)
-dline = dynafy (progline <* optional (char '.' <* (spaces <|> eof)))
+-- dline = dynafy (progline <* optional (char '.' <* (spaces <|> eof)))
+dline = dynafy (progline <* optional (char '.') <* optional newline)
dlines :: MonadParser m => m [Spanned Line]
dlines = dynafy (progline `sepEndBy` (char '.' <* spaces))
--- /dev/null
+{-# LANGUAGE Rank2Types #-}
+module Main where
+
+import Control.Applicative ((<*))
+import qualified Data.Foldable as F
+import System.Console.Editline
+import Text.Trifecta
+
+import qualified Dyna.ParserHS.Parser as DP
+-- import qualified Dyna.NormalizeParse as DNP
+import Dyna.XXX.Trifecta
+
+main :: IO ()
+main = do
+ el <- elInit "dyna"
+ setEditor el Emacs
+ let
+ loop = do
+ setPrompt el (return "Dyna> ")
+ maybeLine <- elGets el
+ case maybeLine of
+ Nothing -> return () -- ctrl-D
+ Just l -> triInteract (DP.dline <* eof)
+ promptCont
+ success
+ failure
+ l
+
+
+ promptCont = do
+ setPrompt el (return " > ")
+ elGets el
+
+ success a = do
+ putStrLn $ "\nParsed: " ++ show a
+ loop
+
+ failure sd = do
+ displayLn $ F.toList sd
+ loop
+ loop
module Dyna.Test.Trifecta where
-import Control.Applicative ((<*))
+import Control.Applicative ((<*),(*>))
import Data.ByteString (ByteString)
import Data.Foldable (toList)
import Data.Monoid (mempty)
extractDiag (Diagnostic (Left s) _ m _) = (Left s, show m)
extractDiag (Diagnostic (Right (Rendering d _ _ _ _)) _ m _) = (Right d, show m)
+
+
+{-# LANGUAGE RankNTypes #-}
-- XXX contribute back to trifecta
module Dyna.XXX.Trifecta (
- identNL, pureSpanned
+ identNL, pureSpanned, stepParserBS, triInteract
) where
import Data.ByteString as Strict hiding (map, zip, foldl, foldr)
+import qualified Data.ByteString.UTF8 as BU
import Control.Applicative
import Control.Monad (when)
import Data.HashSet as HashSet (member)
+import Data.Monoid
+import qualified Data.Semigroup.Reducer as R
+import qualified Data.Sequence as Q
import Text.Trifecta
+import qualified Text.Trifecta.Parser.Step as TPS
+import qualified Text.Trifecta.Parser.Mark as TPM
+
+ -- XXX
+import Debug.Trace
+
+-- | Step a trifecta parser
+--
+-- based on Text.Trifecta.Parser.parseByteString
+stepParserBS :: Show a
+ => (forall r. Parser r String a)
+ -> Delta
+ -> ByteString
+ -> TPS.Step TermDoc a
+stepParserBS p d inp = TPS.feed inp $ stepParser
+ (fmap prettyTerm)
+ (why prettyTerm)
+ (TPM.release d *> p)
+ mempty
+ True
+ mempty
+ mempty
+
-- | Just like ident but without the "lexeme $" prefix
--
-- belongs in Text.Trifecta.Parser.Identifier
-- | Just like "pure" but right here in the parsing state
--
-- belongs in Text.Trifecta.Diagnostic.Rendering.Span
+pureSpanned :: MonadParser f => a -> f (Spanned a)
pureSpanned r = (liftA (r :~) $ Span <$> position <*> position <*> line)
+
+
+-- | A multi-line interaction mechanism, for the REPL.
+--
+-- Maybe this should not be contributed, but it uses so much of the
+-- internals that it surely belongs here beside the other such.
+triInteract :: (Monad m, Show a)
+ => (forall m' . MonadParser m' => m' a) -- ^ Parser
+ -> (m (Maybe String)) -- ^ Continuation callback
+ -> (a -> m ()) -- ^ Success callback
+ -> (Q.Seq (Diagnostic TermDoc) -> m ()) -- ^ Failure callback
+ -> String -- ^ Initial input
+ -> m ()
+triInteract p c s f i = loop (stepParserBS p dd $ BU.fromString i)
+ where
+ loop x = traceShow ("triInteract", x) $ case x of
+ TPS.StepDone _ _ a -> s a
+ TPS.StepFail _ sd -> f sd
+ TPS.StepCont ro re k -> case re of
+ Success _ a -> s a
+ Failure sd -> c >>= maybe (f sd) (loop . k . R.snoc ro)
+
+ dd = Directed (BU.fromString "interactive") 0 0 0 0
+
projects / dyna2 / commitdiff