packages feed

trifecta 0.42 → 0.43

raw patch · 15 files changed

+455/−179 lines, 15 files

Files

Text/Trifecta/Parser.hs view
@@ -17,6 +17,8 @@   , module Text.Trifecta.Parser.Combinators   , module Text.Trifecta.Parser.Token   , module Text.Trifecta.Parser.Result+  , module Text.Trifecta.Parser.Language+  , module Text.Trifecta.Parser.Layout   -- * Expressive Diagnostics   -- ** Text.Trifecta.Diagnostic.Rendering.Caret   , caret@@ -35,6 +37,8 @@ import Text.Trifecta.Parser.Combinators import Text.Trifecta.Parser.Token import Text.Trifecta.Parser.Result+import Text.Trifecta.Parser.Language+import Text.Trifecta.Parser.Layout  import Text.Trifecta.Diagnostic.Rendering.Caret (caret, careted) import Text.Trifecta.Diagnostic.Rendering.Span  (span, spanned)
+ Text/Trifecta/Parser/Language.hs view
@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Parser.Language+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable+--+----------------------------------------------------------------------------+module Text.Trifecta.Parser.Language+  ( Language(..)+  , runLanguage+  , LanguageDef(..)+  , MonadLanguage(..)+  , asksLanguage+  , identifier+  , reserved+  , reservedByteString+  , op+  , reservedOp+  , reservedOpByteString+  , emptyLanguageDef+  , haskellLanguageDef+  , haskell98LanguageDef+  ) where++import Text.Trifecta.Parser.Language.Class+import Text.Trifecta.Parser.Language.Combinators+import Text.Trifecta.Parser.Language.Def+import Text.Trifecta.Parser.Language.Monad+import Text.Trifecta.Parser.Language.Style
+ Text/Trifecta/Parser/Language/Class.hs view
@@ -0,0 +1,48 @@+module Text.Trifecta.Parser.Language.Class+  ( MonadLanguage(..)+  , asksLanguage+  ) where++import Control.Monad (liftM)+import Control.Monad.Trans.Class+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Identity+import qualified Control.Monad.Trans.Writer.Strict as Strict+import qualified Control.Monad.Trans.State.Strict as Strict+import qualified Control.Monad.Trans.RWS.Strict as Strict+import qualified Control.Monad.Trans.Writer.Lazy as Lazy+import qualified Control.Monad.Trans.State.Lazy as Lazy+import qualified Control.Monad.Trans.RWS.Lazy as Lazy+import Data.Monoid+import Text.Trifecta.Parser.Language.Def+import Text.Trifecta.Parser.Token.Class++class MonadTokenParser m => MonadLanguage m where+  askLanguage :: m (LanguageDef m)++asksLanguage :: MonadLanguage m => (LanguageDef m -> r) -> m r+asksLanguage f = liftM f askLanguage++instance MonadLanguage m => MonadLanguage (Strict.StateT s m) where+  askLanguage = liftM liftLanguageDef $ lift askLanguage++instance MonadLanguage m => MonadLanguage (Lazy.StateT s m) where+  askLanguage = liftM liftLanguageDef $ lift askLanguage++instance (Monoid w, MonadLanguage m) => MonadLanguage (Strict.WriterT w m) where+  askLanguage = liftM liftLanguageDef $ lift askLanguage++instance (Monoid w, MonadLanguage m) => MonadLanguage (Lazy.WriterT w m) where+  askLanguage = liftM liftLanguageDef $ lift askLanguage++instance MonadLanguage m => MonadLanguage (ReaderT s m) where+  askLanguage = liftM liftLanguageDef $ lift askLanguage++instance MonadLanguage m => MonadLanguage (IdentityT m) where+  askLanguage = liftM liftLanguageDef $ lift askLanguage++instance (Monoid w, MonadLanguage m) => MonadLanguage (Strict.RWST r w s m) where+  askLanguage = liftM liftLanguageDef $ lift askLanguage++instance (Monoid w, MonadLanguage m) => MonadLanguage (Lazy.RWST r w s m) where+  askLanguage = liftM liftLanguageDef $ lift askLanguage
+ Text/Trifecta/Parser/Language/Combinators.hs view
@@ -0,0 +1,42 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Parser.Language.Combinators+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable+--+----------------------------------------------------------------------------+module Text.Trifecta.Parser.Language.Combinators+  ( identifier+  , reserved+  , reservedByteString+  , op+  , reservedOp+  , reservedOpByteString+  ) where++import Data.ByteString+import Text.Trifecta.Parser.Language.Class+import Text.Trifecta.Parser.Language.Def+import Text.Trifecta.Parser.Token.Identifier++identifier :: MonadLanguage m => m ByteString+identifier = asksLanguage languageIdentifiers >>= ident++reserved :: MonadLanguage m => String -> m ()+reserved i = asksLanguage languageIdentifiers >>= \style -> reserve style i++reservedByteString :: MonadLanguage m => ByteString -> m ()+reservedByteString i = asksLanguage languageIdentifiers >>= \style -> reserveByteString style i++op :: MonadLanguage m => m ByteString+op = asksLanguage languageOperators >>= ident++reservedOp :: MonadLanguage m => String -> m ()+reservedOp i = asksLanguage languageOperators >>= \style -> reserve style i++reservedOpByteString :: MonadLanguage m => ByteString -> m ()+reservedOpByteString i = asksLanguage languageOperators >>= \style -> reserveByteString style i
+ Text/Trifecta/Parser/Language/Def.hs view
@@ -0,0 +1,17 @@+module Text.Trifecta.Parser.Language.Def+  ( LanguageDef(..)+  , liftLanguageDef+  ) where++import Control.Monad.Trans.Class+import Text.Trifecta.Parser.Token.Style+import Text.Trifecta.Parser.Token.Identifier++data LanguageDef m = LanguageDef+  { languageCommentStyle :: CommentStyle+  , languageIdentifiers  :: IdentifierStyle m+  , languageOperators    :: IdentifierStyle m+  }++liftLanguageDef :: (MonadTrans t, Monad m) => LanguageDef m -> LanguageDef (t m)+liftLanguageDef (LanguageDef c i o) = LanguageDef c (liftIdentifierStyle i) (liftIdentifierStyle o)
+ Text/Trifecta/Parser/Language/Monad.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, GeneralizedNewtypeDeriving #-}+module Text.Trifecta.Parser.Language.Monad+  ( Language(..)+  , runLanguage+  ) where++import Control.Applicative+import Control.Monad ()+import Control.Monad.Trans.Class+import Control.Monad.Reader+import Control.Monad.Writer.Class+import Control.Monad.State.Class+import Control.Monad.Cont.Class+import Text.Trifecta.Diagnostic.Class+import Text.Trifecta.Parser.Class+import Text.Trifecta.Parser.Token.Class+import Text.Trifecta.Parser.Token.Combinators+import Text.Trifecta.Parser.Token.Style+import Text.Trifecta.Parser.Language.Def+import Text.Trifecta.Parser.Language.Class++newtype Language m a = Language { unlanguage :: ReaderT (LanguageDef (Language m)) m a }+  deriving (Functor,Applicative,Alternative,Monad,MonadPlus,MonadParser,MonadCont)++runLanguage :: Language m a -> LanguageDef (Language m) -> m a+runLanguage = runReaderT . unlanguage++instance MonadParser m => MonadLanguage (Language m) where+  askLanguage = Language ask++instance MonadTrans Language where+  lift = Language . lift++instance MonadParser m => MonadTokenParser (Language m) where+  whiteSpace = asksLanguage languageCommentStyle >>= buildWhiteSpaceParser+  nesting = id+  semi = symbolic ';'++instance MonadDiagnostic e m => MonadDiagnostic e (Language m) where+  fatalWith xs rs e = lift $ fatalWith xs rs e+  errWith xs rs e = lift $ errWith xs rs e+  logWith l xs rs e = lift $ logWith l xs rs e++instance MonadState s m => MonadState s (Language m) where+  get = Language $ lift get+  put = Language . lift . put++instance MonadWriter w m => MonadWriter w (Language m) where+  tell = Language . lift . tell+  pass = Language . pass . unlanguage+  listen = Language . listen . unlanguage++instance MonadReader e m => MonadReader e (Language m) where+  ask = Language $ lift ask+  local f (Language m) = Language $ ReaderT $ \e -> local f (runReaderT m e)
+ Text/Trifecta/Parser/Language/Style.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Parser.Language.Style+-- Copyright   :  (c) Edward Kmett 2011+-- License     :  BSD3+-- +-- Maintainer  :  ekmett@gmail.com+-- Stability   :  provisional+-- Portability :  non-portable+-- +-----------------------------------------------------------------------------+module Text.Trifecta.Parser.Language.Style+  ( emptyLanguageDef+  , haskellLanguageDef+  , haskell98LanguageDef+  ) where++import Text.Trifecta.Parser.Token.Class+import Text.Trifecta.Parser.Token.Style+import Text.Trifecta.Parser.Token.Identifier.Style+import Text.Trifecta.Parser.Language.Def++emptyLanguageDef, haskellLanguageDef, haskell98LanguageDef :: MonadTokenParser m => LanguageDef m+emptyLanguageDef     = LanguageDef emptyCommentStyle   emptyIdents     emptyOps+haskellLanguageDef   = LanguageDef haskellCommentStyle haskellIdents   haskellOps+haskell98LanguageDef = LanguageDef haskellCommentStyle haskell98Idents haskell98Ops
Text/Trifecta/Parser/Layout.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleInstances, UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module      :  Text.Trifecta.Parser.Layout@@ -12,99 +11,11 @@ ---------------------------------------------------------------------------- module Text.Trifecta.Parser.Layout   ( Layout(..)+  , MonadLayoutParser(..)   , runLayout   , defaultLayoutState   ) where -import Control.Applicative-import Control.Monad-import Control.Monad.State.Class-import Control.Monad.Trans.State.Strict (StateT(..))-import Control.Monad.Writer.Class-import Control.Monad.Reader.Class-import Control.Monad.Cont.Class-import Control.Monad.Trans.Class-import Data.Lens-import Text.Trifecta.Diagnostic.Class-import Text.Trifecta.Parser.Class-import Text.Trifecta.Parser.Combinators-import Text.Trifecta.Parser.Token.Class+import Text.Trifecta.Parser.Layout.Monad import Text.Trifecta.Parser.Layout.Class-import Text.Trifecta.Rope.Delta--newtype Layout m a = Layout { unlayout :: StateT LayoutState m a }-  deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadTrans, MonadCont)--runLayout :: Monad m => Layout m a -> LayoutState -> m (a, LayoutState)-runLayout = runStateT . unlayout--instance MonadTokenParser m => MonadParser (Layout m) where-  satisfy p   = try $ layoutEq Other *> lift (satisfy p)-  satisfy8 p  = try $ layoutEq Other *> lift (satisfy8 p)-  line        = lift line-  mark        = lift mark-  release     = lift . release-  liftIt      = lift . liftIt-  unexpected  = lift . unexpected-  try         = Layout . try . unlayout-  labels m s  = Layout $ labels (unlayout m) s-  skipMany    = Layout . skipMany . unlayout-  highlight h = Layout . highlight h . unlayout--instance MonadDiagnostic e m => MonadDiagnostic e (Layout m) where-  fatalWith xs r e = lift $ fatalWith xs r e-  errWith xs r e   = lift $ errWith xs r e-  logWith l xs r e = lift $ logWith l xs r e--instance MonadTokenParser m => MonadTokenParser (Layout m) where-  whiteSpace = skipOptional $ try (() <$ layoutEq WhiteSpace <?> "")-  nesting (Layout m) = disableLayout $ Layout (nesting m)-  semi = getLayout layoutStack >>= \ stk -> case stk of-    IndentedLayout _:_ -> try (';' <$ layoutEq VirtualSemi <?> "virtual semi-colon")-                      <|> lift semi-    _                  -> lift semi--instance MonadTokenParser m => MonadLayoutParser (Layout m) where-  getLayout l = Layout $ access l-  setLayout l t = () <$ (Layout $ l ~= t)-  modLayout l f = () <$ (Layout $ l %= f)-  layout = do-    bol <- getLayout layoutBol-    m <- mark-    lift whiteSpace-    r <- mark-    if near m r && not bol-      then onside m r-      else do-        stk <- getLayout layoutStack-        case compare (column r) (depth stk) of-          LT -> case stk of-            (IndentedLayout _:xs) -> VirtualRightBrace <$ setLayout layoutStack xs <* setLayout layoutBol True-            [] -> unexpected "empty layout"-            _  -> unexpected "layout"-          EQ -> return VirtualSemi-          GT -> onside m r-    where-      onside m r-        | r /= m    = pure WhiteSpace-        | otherwise = setLayout layoutBol False *> option Other (VirtualRightBrace <$ eof <* trailing)-      trailing = getLayout layoutStack >>= \ stk -> case stk of-          (IndentedLayout _:xs) -> setLayout layoutStack xs-          _ -> empty--      depth []                   = 0-      depth (IndentedLayout r:_) = column r-      depth (DisabledLayout _:_) = -1--instance MonadState s m => MonadState s (Layout m) where-  get = Layout $ lift get-  put = Layout . lift . put--instance MonadReader e m => MonadReader e (Layout m) where-  ask = Layout $ lift ask-  local f (Layout m) = Layout $ local f m--instance MonadWriter w m => MonadWriter w (Layout m) where-  tell = Layout . lift . tell-  listen (Layout m) = Layout $ listen m-  pass (Layout m) = Layout $ pass m+import Text.Trifecta.Parser.Layout.Prim
Text/Trifecta/Parser/Layout/Class.hs view
@@ -1,20 +1,8 @@ {-# LANGUAGE MultiParamTypeClasses #-} module Text.Trifecta.Parser.Layout.Class-  ( LayoutToken(..)-  , LayoutState(..)-  , LayoutContext(..)-  , MonadLayoutParser(..)-  , defaultLayoutState-  , layoutBol-  , layoutStack-  , layoutEq-  , disableLayout-  , enableLayout-  , laidout+  ( MonadLayoutParser(..)   ) where -import Control.Applicative-import Control.Monad (guard) import Data.Lens.Common import Data.Monoid import Control.Monad.Trans.Class@@ -26,72 +14,8 @@ import qualified Control.Monad.Trans.Writer.Strict as Strict import qualified Control.Monad.Trans.RWS.Lazy as Lazy import qualified Control.Monad.Trans.RWS.Strict as Strict-import Text.Trifecta.Rope.Delta-import Text.Trifecta.Rope.Bytes-import Text.Trifecta.Parser.Class+import Text.Trifecta.Parser.Layout.Prim import Text.Trifecta.Parser.Token.Class-import Text.Trifecta.Parser.Token.Combinators-import qualified Text.Trifecta.Highlight.Prim as Highlight-import Text.Trifecta.Diagnostic.Rendering.Prim--data LayoutToken-  = VirtualSemi-  | VirtualRightBrace-  | WhiteSpace-  | Other-  deriving (Eq,Ord,Show,Read)--data LayoutContext-  = IndentedLayout Rendering-  | DisabledLayout Rendering--instance HasDelta LayoutContext where-  delta (IndentedLayout r) = delta r-  delta (DisabledLayout r) = delta r--instance HasBytes LayoutContext where-  bytes = bytes . delta--data LayoutState = LayoutState-  { _layoutBol      :: Bool-  , _layoutStack    :: [LayoutContext]-  }--defaultLayoutState :: LayoutState-defaultLayoutState = LayoutState False []--layoutBol :: Lens LayoutState Bool-layoutBol = lens _layoutBol (\s l -> l { _layoutBol = s})--layoutStack :: Lens LayoutState [LayoutContext]-layoutStack = lens _layoutStack (\s l -> l { _layoutStack = s})--disableLayout :: MonadLayoutParser m => m a -> m a-disableLayout p = do-  r <- rend-  modLayout layoutStack (DisabledLayout r:)-  result <- p-  stk <- getLayout layoutStack-  case stk of-    DisabledLayout r':xs | delta r == delta r' -> result <$ setLayout layoutStack xs-    _ -> unexpected "layout"--enableLayout :: MonadLayoutParser m => m a -> m a-enableLayout p = do-  result <- highlight Highlight.Layout $ do-    r <- rend-    modLayout layoutStack (IndentedLayout r:)-    p-  result <$ layout <?> "virtual right brace"--laidout :: MonadLayoutParser m => m a -> m a-laidout p = braces p <|> enableLayout p--layoutEq :: MonadLayoutParser m => LayoutToken -> m LayoutToken-layoutEq s = try $ do-  r <- layout-  guard (s == r)-  return r  class MonadTokenParser m => MonadLayoutParser m where   layout    :: m LayoutToken
+ Text/Trifecta/Parser/Layout/Combinators.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE MultiParamTypeClasses #-}+module Text.Trifecta.Parser.Layout.Combinators+  ( layoutEq+  , disableLayout+  , enableLayout+  , laidout+  ) where++import Control.Applicative+import Control.Monad (guard)+import Text.Trifecta.Rope.Delta+import Text.Trifecta.Parser.Class+import Text.Trifecta.Parser.Token.Combinators+import qualified Text.Trifecta.Highlight.Prim as Highlight+import Text.Trifecta.Parser.Layout.Class+import Text.Trifecta.Parser.Layout.Prim++disableLayout :: MonadLayoutParser m => m a -> m a+disableLayout p = do+  r <- rend+  modLayout layoutStack (DisabledLayout r:)+  result <- p+  stk <- getLayout layoutStack+  case stk of+    DisabledLayout r':xs | delta r == delta r' -> result <$ setLayout layoutStack xs+    _ -> unexpected "layout"++enableLayout :: MonadLayoutParser m => m a -> m a+enableLayout p = do+  result <- highlight Highlight.Layout $ do+    r <- rend+    modLayout layoutStack (IndentedLayout r:)+    p+  result <$ layout <?> "virtual right brace"++laidout :: MonadLayoutParser m => m a -> m a+laidout p = braces p <|> enableLayout p++layoutEq :: MonadLayoutParser m => LayoutToken -> m LayoutToken+layoutEq s = try $ do+  r <- layout+  guard (s == r)+  return r+
+ Text/Trifecta/Parser/Layout/Monad.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleInstances, UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.Trifecta.Parser.Layout.Monad+-- Copyright   :  (C) 2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable+--+----------------------------------------------------------------------------+module Text.Trifecta.Parser.Layout.Monad+  ( Layout(..)+  , runLayout+  ) where++import Control.Applicative+import Control.Monad+import Control.Monad.State.Class+import Control.Monad.Trans.State.Strict (StateT(..))+import Control.Monad.Writer.Class+import Control.Monad.Reader.Class+import Control.Monad.Cont.Class+import Control.Monad.Trans.Class+import Data.Lens+import Text.Trifecta.Diagnostic.Class+import Text.Trifecta.Parser.Class+import Text.Trifecta.Parser.Combinators+import Text.Trifecta.Parser.Token.Class+import Text.Trifecta.Parser.Layout.Prim+import Text.Trifecta.Parser.Layout.Class+import Text.Trifecta.Parser.Layout.Combinators+import Text.Trifecta.Rope.Delta++newtype Layout m a = Layout { unlayout :: StateT LayoutState m a }+  deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadTrans, MonadCont)++runLayout :: Monad m => Layout m a -> LayoutState -> m (a, LayoutState)+runLayout = runStateT . unlayout++instance MonadTokenParser m => MonadParser (Layout m) where+  satisfy p   = try $ layoutEq Other *> lift (satisfy p)+  satisfy8 p  = try $ layoutEq Other *> lift (satisfy8 p)+  line        = lift line+  mark        = lift mark+  release     = lift . release+  liftIt      = lift . liftIt+  unexpected  = lift . unexpected+  try         = Layout . try . unlayout+  labels m s  = Layout $ labels (unlayout m) s+  skipMany    = Layout . skipMany . unlayout+  highlight h = Layout . highlight h . unlayout++instance MonadDiagnostic e m => MonadDiagnostic e (Layout m) where+  fatalWith xs r e = lift $ fatalWith xs r e+  errWith xs r e   = lift $ errWith xs r e+  logWith l xs r e = lift $ logWith l xs r e++instance MonadTokenParser m => MonadTokenParser (Layout m) where+  whiteSpace = skipOptional $ try (() <$ layoutEq WhiteSpace <?> "")+  nesting (Layout m) = disableLayout $ Layout (nesting m)+  semi = getLayout layoutStack >>= \ stk -> case stk of+    IndentedLayout _:_ -> try (';' <$ layoutEq VirtualSemi <?> "virtual semi-colon")+                      <|> lift semi+    _                  -> lift semi++instance MonadTokenParser m => MonadLayoutParser (Layout m) where+  getLayout l = Layout $ access l+  setLayout l t = () <$ (Layout $ l ~= t)+  modLayout l f = () <$ (Layout $ l %= f)+  layout = do+    bol <- getLayout layoutBol+    m <- mark+    lift whiteSpace+    r <- mark+    if near m r && not bol+      then onside m r+      else do+        stk <- getLayout layoutStack+        case compare (column r) (depth stk) of+          LT -> case stk of+            (IndentedLayout _:xs) -> VirtualRightBrace <$ setLayout layoutStack xs <* setLayout layoutBol True+            [] -> unexpected "empty layout"+            _  -> unexpected "layout"+          EQ -> return VirtualSemi+          GT -> onside m r+    where+      onside m r+        | r /= m    = pure WhiteSpace+        | otherwise = setLayout layoutBol False *> option Other (VirtualRightBrace <$ eof <* trailing)+      trailing = getLayout layoutStack >>= \ stk -> case stk of+          (IndentedLayout _:xs) -> setLayout layoutStack xs+          _ -> empty++      depth []                   = 0+      depth (IndentedLayout r:_) = column r+      depth (DisabledLayout _:_) = -1++instance MonadState s m => MonadState s (Layout m) where+  get = Layout $ lift get+  put = Layout . lift . put++instance MonadReader e m => MonadReader e (Layout m) where+  ask = Layout $ lift ask+  local f (Layout m) = Layout $ local f m++instance MonadWriter w m => MonadWriter w (Layout m) where+  tell = Layout . lift . tell+  listen (Layout m) = Layout $ listen m+  pass (Layout m) = Layout $ pass m
+ Text/Trifecta/Parser/Layout/Prim.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE MultiParamTypeClasses #-}+module Text.Trifecta.Parser.Layout.Prim+  ( LayoutToken(..)+  , LayoutState(..)+  , LayoutContext(..)+  , defaultLayoutState+  , layoutBol+  , layoutStack+  ) where++import Data.Lens.Common+import Text.Trifecta.Rope.Delta+import Text.Trifecta.Rope.Bytes+import Text.Trifecta.Diagnostic.Rendering.Prim++data LayoutToken+  = VirtualSemi+  | VirtualRightBrace+  | WhiteSpace+  | Other+  deriving (Eq,Ord,Show,Read)++data LayoutContext+  = IndentedLayout Rendering+  | DisabledLayout Rendering++instance HasDelta LayoutContext where+  delta (IndentedLayout r) = delta r+  delta (DisabledLayout r) = delta r++instance HasBytes LayoutContext where+  bytes = bytes . delta++data LayoutState = LayoutState+  { _layoutBol      :: Bool+  , _layoutStack    :: [LayoutContext]+  }++defaultLayoutState :: LayoutState+defaultLayoutState = LayoutState False []++layoutBol :: Lens LayoutState Bool+layoutBol = lens _layoutBol (\s l -> l { _layoutBol = s})++layoutStack :: Lens LayoutState [LayoutContext]+layoutStack = lens _layoutStack (\s l -> l { _layoutStack = s})
Text/Trifecta/Parser/Token/Class.hs view
@@ -13,7 +13,6 @@   ( MonadTokenParser(..)   ) where -import Control.Applicative import Control.Monad.Trans.Class import Control.Monad.Trans.State.Lazy as Lazy import Control.Monad.Trans.State.Strict as Strict
Text/Trifecta/Parser/Token/Identifier.hs view
@@ -7,14 +7,15 @@ -- Maintainer  :  ekmett@gmail.com -- Stability   :  provisional -- Portability :  non-portable--- --- idStyle = haskellIdentifierStyle { styleReserved = ... } --- identifier = ident haskellIdentifierStyle--- reserved   = reserve haskellIdentifierStyle --+-- > idStyle = haskellIdentifierStyle { styleReserved = ... }+-- > identifier = ident haskellIdentifierStyle+-- > reserved   = reserve haskellIdentifierStyle+-- ----------------------------------------------------------------------------- module Text.Trifecta.Parser.Token.Identifier   ( IdentifierStyle(..)+  , liftIdentifierStyle   , ident   , reserve   , reserveByteString@@ -25,6 +26,7 @@ import Data.HashSet as HashSet import Control.Applicative import Control.Monad (when)+import Control.Monad.Trans.Class import Text.Trifecta.Parser.Class import Text.Trifecta.Parser.Char import Text.Trifecta.Parser.Combinators@@ -41,6 +43,13 @@   , styleReservedHighlight :: Highlight   } +-- | Lift an identifier style into a monad transformer+liftIdentifierStyle :: (MonadTrans t, Monad m) => IdentifierStyle m -> IdentifierStyle (t m)+liftIdentifierStyle s =+  s { styleStart  = lift (styleStart s)+    , styleLetter = lift (styleLetter s)+    }+ -- | parse a reserved operator or identifier using a given style reserve :: MonadTokenParser m => IdentifierStyle m -> String -> m () reserve s name = reserveByteString s $! UTF8.fromString name@@ -48,7 +57,7 @@ -- | parse a reserved operator or identifier using a given style specified by bytestring reserveByteString :: MonadTokenParser m => IdentifierStyle m -> ByteString -> m () reserveByteString s name = lexeme $ try $ do-   _ <- highlight (styleReservedHighlight s) $ byteString name +   _ <- highlight (styleReservedHighlight s) $ byteString name    notFollowedBy (styleLetter s) <?> "end of " ++ show name  -- | parse an non-reserved identifier or symbol
trifecta.cabal view
@@ -1,6 +1,6 @@ name:          trifecta category:      Text, Parsing, Diagnostics, Pretty Printer, Logging-version:       0.42+version:       0.43 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -12,8 +12,6 @@ synopsis:      A modern parser combinator library with convenient diagnostics description:   A modern unicode-aware parser combinator library with slicing and Clang-style colored diagnostics-  .-  Current documentation is available from <http://ekmett.github.com/trifecta/>.  build-type:    Simple extra-source-files:@@ -67,8 +65,17 @@     Text.Trifecta.Parser.Combinators     Text.Trifecta.Parser.Expr     Text.Trifecta.Parser.It+    Text.Trifecta.Parser.Language+    Text.Trifecta.Parser.Language.Class+    Text.Trifecta.Parser.Language.Combinators+    Text.Trifecta.Parser.Language.Def+    Text.Trifecta.Parser.Language.Monad+    Text.Trifecta.Parser.Language.Style     Text.Trifecta.Parser.Layout     Text.Trifecta.Parser.Layout.Class+    Text.Trifecta.Parser.Layout.Combinators+    Text.Trifecta.Parser.Layout.Monad+    Text.Trifecta.Parser.Layout.Prim     Text.Trifecta.Parser.Perm     Text.Trifecta.Parser.Prim     Text.Trifecta.Parser.Result