diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,4 @@ +# 0.0 + +* Split `indentation` into separate `indentation-core`, `indentation-parsec` and `indentation-trifecta` packages. + Keep the original `indentation` for backward compatability and as a general roll-up package. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) 2014, Michael D. Adams +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, +this list of conditions and the following disclaimer in the documentation +and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its contributors +may be used to endorse or promote products derived from this software without +specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/indentation-trifecta.cabal b/indentation-trifecta.cabal new file mode 100644 --- /dev/null +++ b/indentation-trifecta.cabal @@ -0,0 +1,67 @@ +name: indentation-trifecta +version: 0.0 +synopsis: Indentation sensitive parsing combinators for Trifecta +description: Indentation sensitive parsing combinators for Trifecta. + . + See + . + __Michael D. Adams and Ömer S. Ağacan__. + Indentation-sensitive parsing for Parsec. + In /Proceedings of the 2014 ACM SIGPLAN Symposium on Haskell/, + Haskell ’14, pages 121–132. + ACM, New York, NY, USA, September 2014. ISBN 978-1-4503-3041-1. + . + . + This package provides indentation combinators for + Trifecta. For Parsec, install + indentation-parsec. For backward compatability + or to install both, install indentation. + +license: BSD3 +license-file: LICENSE +author: Michael D. Adams +maintainer: Ömer Sinan Ağacan + Aleksey Kliger +category: Parsing +build-type: Simple +cabal-version: >=1.10 +extra-source-files: CHANGELOG.md + +homepage: https://bitbucket.org/adamsmd/indentation +bug-reports: https://bitbucket.org/adamsmd/indentation/issues +tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 + +source-repository head + type: git + location: https://bitbucket.org/adamsmd/indentation.git + +library + hs-source-dirs: src + build-depends: base >=4.6 && <4.10, + mtl >=2.1, + indentation-core == 0.0, + trifecta >=1.4 && <1.6, + parsers >=0.10 && <0.13 + exposed-modules: Text.Trifecta.Indentation + + default-language: Haskell2010 + + ghc-options: -Wall + +test-suite test-indentation + default-language: + Haskell2010 + type: + exitcode-stdio-1.0 + hs-source-dirs: + tests + main-is: all-tests.hs + build-depends: + trifecta + other-modules: + ParensTrifecta + build-depends: + base >= 4 && < 5 + , tasty >= 0.10 + , tasty-hunit >= 0.9 + , indentation-trifecta diff --git a/src/Text/Trifecta/Indentation.hs b/src/Text/Trifecta/Indentation.hs new file mode 100644 --- /dev/null +++ b/src/Text/Trifecta/Indentation.hs @@ -0,0 +1,185 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, GeneralizedNewtypeDeriving, StandaloneDeriving #-} + +-- Implements "Indentation Senstivie Parsing" for Trifecta +module Text.Trifecta.Indentation ( + I.IndentationRel(..), I.Indentation, I.infIndentation, I.mkIndentationState, + I.IndentationState, + IndentationParsing(..), + Token, + IndentationParserT, + runIndentationParserT, + evalIndentationParserT, + execIndentationParserT, + ) where + +import Control.Applicative +import Control.Monad.State.Lazy as LazyState +import Control.Monad.State.Strict as StrictState + +import Text.Parser.Combinators (Parsing(..)) +import Text.Parser.Token (TokenParsing(..)) +import Text.Parser.Char (CharParsing(..)) +import Text.Parser.LookAhead (LookAheadParsing(..)) +import Text.Trifecta.Combinators (DeltaParsing(..), MarkParsing(..)) +import Text.Trifecta.Delta (Delta, column) + +import Text.Parser.Indentation.Implementation (IndentationState(..), IndentationRel(..), LocalState) +import qualified Text.Parser.Indentation.Implementation as I + +-------------- +-- User API -- +-------------- + +class IndentationParsing m where + localTokenMode :: (IndentationRel -> IndentationRel) -> m a -> m a + localIndentation :: IndentationRel -> m a -> m a + absoluteIndentation :: m a -> m a + ignoreAbsoluteIndentation :: m a -> m a + localAbsoluteIndentation :: m a -> m a + localAbsoluteIndentation = ignoreAbsoluteIndentation . absoluteIndentation + +---------------------- +-- Lifted Instances -- +---------------------- + +{- TODO: +Applicative +Functor +MonadWriter w m +MonadError e m +Monad m +MonadReader r m +MonadTrans (StateT s) +Monad m +Monad m +MonadFix m +MonadPlus m +MonadIO m +MonadCont m +#-} + +{-# INLINE liftLazyStateT2 #-} +liftLazyStateT2 :: (m (a, s) -> m (a, s)) -> LazyState.StateT s m a -> LazyState.StateT s m a +liftLazyStateT2 f m = LazyState.StateT $ \s -> f (LazyState.runStateT m s) + +instance (IndentationParsing i) => IndentationParsing (LazyState.StateT s i) where + localTokenMode f = liftLazyStateT2 (localTokenMode f) + localIndentation r = liftLazyStateT2 (localIndentation r) + absoluteIndentation = liftLazyStateT2 absoluteIndentation + ignoreAbsoluteIndentation = liftLazyStateT2 ignoreAbsoluteIndentation + localAbsoluteIndentation = liftLazyStateT2 localAbsoluteIndentation + +{-# INLINE liftStrictStateT2 #-} +liftStrictStateT2 :: (m (a, s) -> m (a, s)) -> StrictState.StateT s m a -> StrictState.StateT s m a +liftStrictStateT2 f m = StrictState.StateT $ \s -> f (StrictState.runStateT m s) + +instance (IndentationParsing i) => IndentationParsing (StrictState.StateT s i) where + localTokenMode f = liftStrictStateT2 (localTokenMode f) + localIndentation r = liftStrictStateT2 (localIndentation r) + absoluteIndentation = liftStrictStateT2 absoluteIndentation + ignoreAbsoluteIndentation = liftStrictStateT2 ignoreAbsoluteIndentation + localAbsoluteIndentation = liftStrictStateT2 localAbsoluteIndentation + +--------------- +-- Data Type -- +--------------- + +-- TODO: do we need a strict version of this? +newtype IndentationParserT t m a = IndentationParserT { unIndentationParserT :: LazyState.StateT IndentationState m a } + deriving (Functor, Applicative, Monad, MonadTrans, MonadPlus, Alternative) + +deriving instance (Parsing m, MonadPlus m) => Parsing (IndentationParserT t m) +deriving instance (DeltaParsing m) => DeltaParsing (IndentationParserT Char m) +deriving instance (MarkParsing Delta m) => MarkParsing Delta (IndentationParserT Char m) +deriving instance (DeltaParsing m) => DeltaParsing (IndentationParserT Token m) +deriving instance (MarkParsing Delta m) => MarkParsing Delta (IndentationParserT Token m) + +{-# INLINE runIndentationParserT #-} +runIndentationParserT :: IndentationParserT t m a -> IndentationState -> m (a, IndentationState) +runIndentationParserT (IndentationParserT m) = LazyState.runStateT m + +{-# INLINE evalIndentationParserT #-} +evalIndentationParserT :: (Monad m) => IndentationParserT t m a -> IndentationState -> m a +evalIndentationParserT (IndentationParserT m) = LazyState.evalStateT m + +{-# INLINE execIndentationParserT #-} +execIndentationParserT :: (Monad m) => IndentationParserT t m a -> IndentationState -> m IndentationState +execIndentationParserT (IndentationParserT m) = LazyState.execStateT m + +--------------------- +-- Class Instances -- +--------------------- + +-- Putting the check in CharParsing -- + +instance (DeltaParsing m) => CharParsing (IndentationParserT Char m) where + satisfy f = checkIndentation (satisfy f) + +instance (DeltaParsing m) => TokenParsing (IndentationParserT Char m) where + someSpace = IndentationParserT $ someSpace -- Ignore indentation of whitespace + +-- Putting the check in TokenParsing -- + +data Token + +instance (DeltaParsing m) => CharParsing (IndentationParserT Token m) where + satisfy f = IndentationParserT $ satisfy f + +instance (DeltaParsing m) => TokenParsing (IndentationParserT Token m) where + token p = checkIndentation (token (unIndentationParserT p)) + +-------- + +instance (LookAheadParsing m, MonadPlus m) => LookAheadParsing (IndentationParserT t m) where + lookAhead m = IndentationParserT $ do + s <- get + x <- lookAhead (unIndentationParserT m) + put s + return x + +-------- + +instance (Monad m) => IndentationParsing (IndentationParserT t m) where + {-# INLINE localTokenMode #-} + localTokenMode = I.localTokenMode localState + + {-# INLINE localIndentation #-} + localIndentation = I.localIndentation localStateUnlessAbsMode + + {-# INLINE absoluteIndentation #-} + absoluteIndentation = I.absoluteIndentation localState + + {-# INLINE ignoreAbsoluteIndentation #-} + ignoreAbsoluteIndentation = I.ignoreAbsoluteIndentation localState + + {-# INLINE localAbsoluteIndentation #-} + localAbsoluteIndentation = I.localAbsoluteIndentation localState + +--------------------- +-- Private Helpers -- +--------------------- + +{-# INLINE localState #-} +localState :: (Monad m) => LocalState (IndentationParserT t m a) +localState pre post m = IndentationParserT $ do + is <- get + put (pre is) + x <- unIndentationParserT m + is' <- get + put (post is is') + return x + +{-# INLINE localStateUnlessAbsMode #-} +localStateUnlessAbsMode :: (Monad m) => LocalState (IndentationParserT t m a) +localStateUnlessAbsMode pre post m = IndentationParserT $ do + a <- gets I.indentationStateAbsMode + unIndentationParserT $ if a then m else localState pre post m + +{-# INLINE checkIndentation #-} +checkIndentation :: (DeltaParsing m) => LazyState.StateT IndentationState m a -> IndentationParserT t m a +checkIndentation m = IndentationParserT $ do + is <- get + p <- position + let ok is' = do x <- m; put is'; return x + err msg = fail msg + I.updateIndentation is (fromIntegral $ column p + 1) ok err diff --git a/tests/ParensTrifecta.hs b/tests/ParensTrifecta.hs new file mode 100644 --- /dev/null +++ b/tests/ParensTrifecta.hs @@ -0,0 +1,109 @@ +module ParensTrifecta where + +import Data.Monoid (Monoid(..)) +import Control.Applicative + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (testCase, assertEqual, assertFailure, Assertion) + +import Text.Trifecta +import Text.Trifecta.Indentation + +data A + = Par A -- '(' A ')' + | Bra A -- '[' A ']' + | Seq A A -- A A + | Nil -- epsilon + deriving (Show, Eq) + +-- a :: (Monad m, Stream s m (Char, Indentation)) => ParsecT (IndentStream s) () m A +a :: (Applicative m, TokenParsing m, IndentationParsing m) => m A +a = choice [ Seq <$> a' <*> a, a', pure Nil ] + +-- a' :: (Monad m, Stream s m (Char, Indentation)) => ParsecT (IndentStream s) () m A +a' :: (TokenParsing m, IndentationParsing m) => m A +a' = choice + [ Par <$> + between (localTokenMode (const Eq) $ symbolic '(') + (localTokenMode (const Eq) $ symbolic ')') + (localIndentation Gt a) + , Bra <$> + between (localTokenMode (const Ge) $ symbolic '[') + (localTokenMode (const Ge) $ symbolic ']') + (localIndentation Gt a) + ] + + +evalCharIndentationParserT :: Monad m => IndentationParserT Char m a -> IndentationState -> m a +evalCharIndentationParserT = evalIndentationParserT + +evalTokenIndentationParserT :: Monad m => IndentationParserT Token m a -> IndentationState -> m a +evalTokenIndentationParserT = evalIndentationParserT + +runParse ev input + = let indA = ev a $ mkIndentationState 0 infIndentation True Gt + in case parseString indA mempty input of + Failure err -> Left (show err) + Success a -> Right a + +runCharParse = runParse evalCharIndentationParserT +runTokenParse = runParse evalTokenIndentationParserT + +-- conveniences for tests +parL = Par . listToSeq +braL = Bra . listToSeq + +listToSeq [] = Nil +listToSeq (x:xs) = Seq x $ listToSeq xs + +input1 = unlines [ "(" + , " [(" + , " )" + , " ]" + , ")" + ] +output1c = runCharParse input1 +output1t = runTokenParse input1 +expected1 = listToSeq [ parL [braL [parL []]] + ] + +input2 = unlines [ "(" + , " [" + , " (" + , " )" + , " []" + , " ]" + , " (" + , " )" + , ")" + ] +output2c = runCharParse input2 +output2t = runTokenParse input2 +expected2 = listToSeq [ parL [ braL [ parL [] + , braL [] + ] + , parL [] + ] + ] + + +assertParsedOk :: (Show err, Show a, Eq a) => Either err a -> a -> Assertion +assertParsedOk actual expected = + case actual of + Right ok -> assertEqual "parsing succeeded, but " expected ok + Left err -> assertFailure ("parse failed with " ++ show err + ++ ", expected " ++ show expected) + +allTests :: TestTree +allTests = + testGroup "parens (trifecta)" + [ + testGroup "char parsing" + [ testCase "1" $ assertParsedOk output1c expected1 + , testCase "2" $ assertParsedOk output2c expected2 + ] + , testGroup "token parsing" + [ testCase "1" $ assertParsedOk output1t expected1 + , testCase "2" $ assertParsedOk output2t expected2 + ] + ] diff --git a/tests/all-tests.hs b/tests/all-tests.hs new file mode 100644 --- /dev/null +++ b/tests/all-tests.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE CPP #-} +module Main where + +import Test.Tasty (defaultMain, testGroup) +import qualified ParensTrifecta + +main = + defaultMain $ testGroup "All tests" $ + [ + ParensTrifecta.allTests + ]