Kawaii-Parser 3.0.0 → 4.0.0

raw patch · 5 files changed

+291/−262 lines, 5 filesdep +transformersdep −generic-lensdep −lensPVP ok

version bump matches the API change (PVP)

Dependencies added: transformers

Dependencies removed: generic-lens, lens

API changes (from Hackage documentation)

Files

• Kawaii-Parser.cabal +6/−13
• Parser/Files.hs +176/−0
• Parser/Locations.hs +4/−9
• Parser/Parser.hs +100/−177
• Parser/Utilities.hs +5/−63

@@ -5,26 +5,19 @@   The library provides a tiny general utilities module, and a simple combinator-based tokeniser and parser. Its main focus is   not efficiency but simplicity of implementation and use. The choice operator for parsers is symmetric, avoiding the need to   think about the order in which the alternatives are listed. The library provides error locations and supports adding locations-  to the parse tree.+  to the parse tree. The library also provides a module for conveniently handling relative file paths. license: BSD-3-Clause license-file: LICENSE maintainer: liisikerik@hotmail.com name: Kawaii-Parser synopsis: A simple parsing library and some additional utilities.-version: 3.0.0+version: 4.0.0 library-  build-depends:-    base >= 3.0.3.1 && < 4.22,-    containers >= 0.1.0.0 && < 0.9,-    directory >= 1.0.0.0 && < 1.4,-    generic-lens >= 0.1.0.0 && < 2.3,-    lens >= 0.1 && < 5.4,-    mtl >= 1.0 && < 2.4-  default-extensions:-    DeriveGeneric, FlexibleInstances, MultiParamTypeClasses, OverloadedLabels, ScopedTypeVariables, StandaloneDeriving+  build-depends: base < 4.21, containers, directory, mtl, transformers+  default-extensions: FlexibleContexts, ScopedTypeVariables, StandaloneDeriving   default-language: Haskell2010-  exposed-modules: Parser.Locations, Parser.Parser, Parser.Utilities-  ghc-options: -Wall+  exposed-modules: Parser.Files, Parser.Locations, Parser.Parser, Parser.Utilities+  ghc-options: -Wall -Wno-x-partial source-repository head   location: https://github.com/liisikerik/kawaii_parser.git   type: git

@@ -0,0 +1,176 @@+{-|+Description: Relative directories and file paths.++* Relative directories and file paths.+-}+module Parser.Files (+  Back (..),+  Directory (..),+  Error (..),+  Ext,+  File_path (..),+  File_path_and_location (..),+  (<//>),+  drop_file_name,+  parse_file_path,+  read_file,+  write_file,+  write_file_path_and_location) where+  import Control.Monad+  import Control.Monad.Except+  import Control.Monad.IO.Class+  import Data.Char+  import Data.Maybe+  import Parser.Locations+  import Parser.Parser+  import Parser.Utilities+  import System.Directory+  -- | Parent directory.+  data Back = Back+  data Char_class = Delimiter_char Token | Invalid_char | Name_char Char+  -- | Relative directory.+  data Directory = Directory [Back] [String]+  -- | Errors.+  data Error = Failed_to_find_the_file FilePath | Invalid_file_path | Unexpected_file_extension Ext+  type Ext = String+  -- | Relative file path.+  data File_path = File_path Directory String Ext+  -- | Locations with a file path.+  data File_path_and_location = File_path_and_location File_path Location+  type Parser = Parser' Token Error+  data Token = Dot_token | Name_token String | Slash_token+  type Tokeniser = Tokeniser' Char_class Token Error+  -- | Prepend a directory to file path.+  infixr 6 <//>+  (<//>) :: Directory -> File_path -> File_path+  directory_0 <//> File_path directory_1 file_name ext = File_path (directory_0 <> directory_1) file_name ext+  deriving instance Eq Back+  deriving instance Eq Char_class+  deriving instance Eq Directory+  deriving instance Eq File_path+  deriving instance Eq Token+  instance Monoid Directory where+    mempty = Directory [] []+  deriving instance Ord Back+  deriving instance Ord Directory+  deriving instance Ord File_path+  instance Semigroup Directory where+    Directory back_0 directories_0 <> Directory back_1 directories_1 =+      case (directories_0, back_1) of+        ([], _) -> Directory (back_0 <> back_1) directories_1+        (_, []) -> Directory back_0 (directories_0 <> directories_1)+        (_ : _, Back : _) -> Directory back_0 (init directories_0) <> Directory (tail back_1) directories_1+  deriving instance Show Back+  deriving instance Show Char_class+  deriving instance Show Directory+  deriving instance Show Error+  deriving instance Show File_path+  deriving instance Show File_path_and_location+  deriving instance Show Token+  check_ext :: (MonadError Error f) => Ext -> File_path -> f ()+  check_ext expected_ext (File_path _ _ actual_ext) = check (Unexpected_file_extension actual_ext) (expected_ext == actual_ext)+  check_file_path :: (MonadError Error f) => Ext -> File_path -> f ()+  check_file_path ext file_path =+    do+      check Invalid_file_path (valid_file_path file_path)+      check_ext ext file_path+  classify_char :: Char -> Char_class+  classify_char c =+    case c of+      _ | valid_name_char c -> Name_char c+      '.' -> Delimiter_char Dot_token+      '/' -> Delimiter_char Slash_token+      _ -> Invalid_char+  delimiter_char :: Char_class -> Maybe Token+  delimiter_char char_class =+    case char_class of+      Delimiter_char token -> Just token+      _ -> Nothing+  -- | Get the directory part of a file path.+  drop_file_name :: File_path -> Directory+  drop_file_name (File_path directory _ _) = directory+  name_char :: Char_class -> Maybe Char+  name_char char_class =+    case char_class of+      Name_char c -> Just c+      _ -> Nothing+  name_token :: Token -> Maybe String+  name_token token =+    case token of+      Name_token name -> Just name+      _ -> Nothing+  parse_back :: Parser Back+  parse_back =+    do+      replicateM_ 2 parse_dot+      return Back+  parse_directory :: Parser Directory+  parse_directory = Directory <$> parse_many (parse_with_slash parse_back) <*> parse_many (parse_with_slash parse_name)+  parse_dot :: Parser ()+  parse_dot = parse_token Dot_token+  -- | Parse a file path and check the extension.+  parse_file_path :: Ext -> String -> Either Error File_path+  parse_file_path expected_ext file_path =+    do+      file_path' <- fromJust (parse' classify_char (\ _ -> id) tokenise parse_file_path' (\ _ -> Invalid_file_path) file_path)+      check_ext expected_ext file_path'+      return file_path' where+    parse_file_path' :: Parser File_path+    parse_file_path' =+      do+        directory <- parse_directory+        file_name <- parse_name+        parse_dot+        actual_ext <- parse_name+        return (File_path directory file_name actual_ext)+  parse_name :: Parser String+  parse_name = parse_token' name_token+  parse_with_slash :: Parser t -> Parser t+  parse_with_slash parse_t =+    do+      x <- parse_t+      parse_token Slash_token+      return x+  -- | Check the extension and read the file.+  read_file :: Ext -> File_path -> ExceptT Error IO String+  read_file ext file_path =+    do+      check_file_path ext file_path+      let file_path' = write_file_path file_path+      file_exits <- liftIO (doesPathExist file_path')+      case file_exits of+        False -> throwError (Failed_to_find_the_file file_path')+        True -> liftIO (readFile file_path')+  tokenise :: Tokeniser ()+  tokenise = void (parse_many tokenise_1)+  tokenise_1 :: Tokeniser ()+  tokenise_1 = tokenise_delimiter <+> tokenise_name+  tokenise_delimiter :: Tokeniser ()+  tokenise_delimiter = add_token (parse_token' delimiter_char)+  tokenise_name :: Tokeniser ()+  tokenise_name = add_token (Name_token <$> parse_some (parse_token' name_char))+  valid_directory :: Directory -> Bool+  valid_directory (Directory _ directories) = all valid_name directories+  valid_file_path :: File_path -> Bool+  valid_file_path (File_path directory file_name ext) =+    valid_directory directory && valid_name file_name && valid_name ext+  valid_name :: String -> Bool+  valid_name = all valid_name_char+  valid_name_char :: Char -> Bool+  valid_name_char c = elem c "'_" || isLetter c || isDigit c+  write_back :: Back -> String+  write_back Back = ".."+  write_directory :: Directory -> FilePath+  write_directory (Directory back directories) = join (write_with_slash <$> ((write_back <$> back) <> directories))+  -- | Check the extension and write to the file.+  write_file :: Ext -> File_path -> String -> ExceptT Error IO ()+  write_file ext file_path file =+    do+      check_file_path ext file_path+      liftIO (writeFile (write_file_path file_path) file)+  write_file_path :: File_path -> FilePath+  write_file_path (File_path directory file_name ext) = write_directory directory <> file_name <> "." <> ext+  write_file_path_and_location :: File_path -> Location -> String+  write_file_path_and_location file_path location = write_file_path file_path <> ":" <> write_location location+  write_with_slash :: String -> String+  write_with_slash text = text <> "/"

@@ -4,26 +4,24 @@ * Locations. -} module Parser.Locations (-  File_path_and_location (..),   Location,   With_location (..),   init_location,   next_char,   next_line,-  write_file_path_and_location,   write_location) where-  import Parser.Utilities   deriving instance Eq Location   deriving instance Ord Location-  deriving instance Show File_path_and_location   deriving instance Show Location   deriving instance Show t => Show (With_location t)-  -- | Locations with a file path.-  data File_path_and_location = File_path_and_location File_path Location   -- | Locations.   data Location = Location Integer Integer   -- | Add a location to any type.   data With_location t = With_location Location t+  instance Monoid Location where+    mempty = init_location+  instance Semigroup Location where+    (<>) = max   -- | First line, first character.   init_location :: Location   init_location = Location 1 1@@ -33,9 +31,6 @@   -- | Move to the next line.   next_line :: Location -> Location   next_line (Location line _) = Location (1 + line) 1-  -- | Write the location with the file path.-  write_file_path_and_location :: File_path -> Location -> String-  write_file_path_and_location file_path location = write_file_path file_path <> ":" <> write_location location   -- | Write the location.   write_location :: Location -> String   write_location (Location line char) = show line <> ":" <> show char

@@ -1,14 +1,11 @@ {-|-Description: Tokenising and parsing.+Description: Combinator-based tokeniser and parser with symmetric choice and location tracking. -* A combinator-based tokeniser with symmetric choice and location tracking.-* An unambiguous parser with symmetric choice and location tracking.+* Combinator-based tokeniser and parser with symmetric choice and location tracking. -} module Parser.Parser (-  Parse_error (..),   Parser',   Tokeniser',-  Usage_error (..),   (<+>),   add_location,   add_token,@@ -17,76 +14,57 @@   parse',   parse_brackets,   parse_default,-  parse_file_path',   parse_list,   parse_location,   parse_many,   parse_non_empty_list,-  parse_not,   parse_some,   parse_token,-  parse_token',-  parse_with_location) where-  import Control.Lens.Combinators-  import Control.Lens.Operators+  parse_token') where   import Control.Monad.Except   import Control.Monad.RWS.Strict-  import Data.Generics.Labels ()-  import GHC.Generics+  import Control.Monad.State.Strict+  import Control.Monad.Trans.Maybe+  import Control.Monad.Writer.Strict+  import Data.Foldable   import Parser.Locations   import Parser.Utilities   newtype Parser token output error t =-    Parser {run_parser' :: RWST () output (Parser.Parser.State token) (ExceptT (Parse_error error) (Either Usage_error)) t}+    Parser {run_parser' :: Tokens token -> (Location, Maybe (Maybe (Either error (t, output)), Tokens token))}   -- | A parser that works on any kind of tokens.   type Parser' token error = Parser token () error-  -- | Parse errors.-  data Parse_error error = Filter_error error | Parse_error' Location-  data State token = State {state_tokens :: Tokens token, state_lookahead :: Location}   -- | A tokeniser that works on any kind of custom characters and tokens. The custom character type is useful if you need to   -- classify characters before tokenisation to simplify patternmatching.   type Tokeniser' char_class token error = Parser char_class [With_location token] error-  -- | A sequence of tokens with locations. For internal use in the parser.   data Tokens token = Tokens [With_location token] Location-  -- | Errors that indicate that the parsing library has been used incorrectly.-  data Usage_error = Ambiguity | Attempt_to_recover_a_filter_error | Filter_error_encountered_in_parse_not-  -- | Symmetric choice between two parsers that selects the longest match. Note that if both parsers successfully reach the-  -- same location it will result in an ambiguity error. Also note that you should not attempt to recover a filter error. This-  -- operator is normally associative unless you make a mistake and write an ambiguous parser.+  -- | Symmetric choice between two parsers.   infixr 3 <+>-  (<+>) :: Parser token output error t -> Parser token output error t -> Parser token output error t-  Parser (RWST parse_0) <+> Parser (RWST parse_1) =+  (<+>) :: (Monoid output) => Parser token output error t -> Parser token output error t -> Parser token output error t+  Parser parse_0 <+> Parser parse_1 =     Parser-      (RWST-        (\ () st ->-          ExceptT-            (do-              (lookahead_0, result_0) <- deconstruct_result (parse_0 () st)-              (lookahead_1, result_1) <- deconstruct_result (parse_1 () st)-              (-                construct_result (max lookahead_0 lookahead_1) <$>-                case (result_0, result_1) of-                  (Nothing, Nothing) -> Right Nothing-                  (Nothing, Just _) -> Right result_1-                  (Just _, Nothing) -> Right result_0-                  (Just (_, tokens_0, _), Just (_, tokens_1, _)) ->-                    case compare (current_location tokens_0) (current_location tokens_1) of-                      LT -> Right result_1-                      EQ -> Left Ambiguity-                      GT -> Right result_0))))-  instance Monoid output => Applicative (Parser token output error) where-    Parser parse_0 <*> Parser parse_1 = Parser (parse_0 <*> parse_1)-    pure x = Parser (return x)+      (\ tokens ->+        do+          result_0 <- parse_0 tokens+          result_1 <- parse_1 tokens+          return+            (case (result_0, result_1) of+              (Nothing, _) -> result_1+              (_, Nothing) -> result_0+              (Just (_, tokens_0), Just (_, tokens_1)) ->+                case compare (count_tokens tokens_0) (count_tokens tokens_1) of+                  LT -> result_0+                  EQ -> Just (Nothing, tokens_0)+                  GT -> result_1))+  instance (Monoid output) => Applicative (Parser token output error) where+    parse_0 <*> parse_1 = monad_to_parser (parser_to_monad parse_0 <*> parser_to_monad parse_1)+    pure x = monad_to_parser (return x)   instance Functor (Parser token output error) where-    fmap f (Parser parse_t) = Parser (f <$> parse_t)-  deriving instance Generic (Parser.Parser.State token)-  instance Monoid output => Monad (Parser token output error) where-    Parser parse_t >>= f = Parser (parse_t >>= run_parser' <$> f)-  deriving instance Show error => Show (Parse_error error)-  deriving instance Show token => Show (Parser.Parser.State token)-  deriving instance Show token => Show (Tokens token)-  deriving instance Show Usage_error+    fmap f parse = monad_to_parser (f <$> parser_to_monad parse)+  instance (Monoid output) => Monad (Parser token output error) where+    parse >>= f = monad_to_parser (parser_to_monad parse >>= parser_to_monad <$> f)+  deriving instance (Show token) => Show (Tokens token)   -- | Parse with location.-  add_location :: Monoid output => Parser token output error t -> Parser token output error (With_location t)+  add_location :: (Monoid output) => Parser token output error t -> Parser token output error (With_location t)   add_location parse_t = With_location <$> parse_location <*> parse_t   -- | Add the token to the output.   add_token :: Tokeniser' char_class token error token -> Tokeniser' char_class token error ()@@ -94,39 +72,23 @@     do       location <- parse_location       token <- tokenise-      Parser (tell [With_location location token])-  certain_token :: Eq token => token -> token -> Maybe ()+      monad_to_parser (tell [With_location location token])+  certain_token :: (Eq token) => token -> token -> Maybe ()   certain_token token token' =     do       check () (token == token')       return ()-  construct_result ::-    Location -> Maybe (t, Tokens token, output) -> Either (Parse_error error) (t, Parser.Parser.State token, output)-  construct_result lookahead result =-    case result of-      Nothing -> Left (Parse_error' lookahead)-      Just (x, tokens, output) -> Right (x, State tokens lookahead, output)-  -- | Get the location of first token or, if there are none, the end of file. For internal use in the parser.+  count_tokens :: Tokens token -> Int+  count_tokens (Tokens tokens _) = length tokens+  -- | Get the location of first token or, if there are none, the end of file.   current_location :: Tokens token -> Location   current_location (Tokens tokens end_location) =     case tokens of       [] -> end_location       With_location location _ : _ -> location-  deconstruct_result ::-    (-      ExceptT (Parse_error error) (Either Usage_error) (t, Parser.Parser.State token, output) ->-      Either Usage_error (Location, Maybe (t, Tokens token, output)))-  deconstruct_result (ExceptT maybe_result) =-    do-      result <- maybe_result-      case result of-        Left err ->-          case err of-            Filter_error _ -> Left Attempt_to_recover_a_filter_error-            Parse_error' lookahead -> Right (lookahead, Nothing)-        Right (x, State tokens lookahead, output) -> Right (lookahead, Just (x, tokens, output))-  -- | Filter the parse results - for example, restrict an integer parser to positive numbers. You also have to provide an-  -- error. Note that filter errors, unlike token matching errors, are non-recoverable.+  filter_error :: error -> Parser token output error t+  filter_error err = Parser (\ tokens -> return (Just (Just (Left err), tokens)))+  -- | Filter parse results - for example, restrict an integer parser to positive numbers. You also have to provide an error.   filter_parser :: (Eq token, Monoid output) =>     (t -> Bool) -> (Location -> error) -> Parser token output error t -> Parser token output error t   filter_parser f err =@@ -135,8 +97,7 @@         do           check err (f x)           Right x)-  -- | Filter and transform the parse results in one operation. You also have to provide an error. Note that filter errors,-  -- unlike matching errors, are non-recoverable.+  -- | Filter and transform the parse results in one operation. You also have to provide an error.   fmap_filter_parser :: (Eq token, Monoid output) =>     (t -> Either (Location -> error) u) -> Parser token output error t -> Parser token output error u   fmap_filter_parser f parse_t =@@ -144,16 +105,22 @@       location <- parse_location       x <- parse_t       case f x of-        Left err -> Parser (throwError (Filter_error (err location)))+        Left err -> filter_error (err location)         Right y -> return y-  get_tokens :: Monoid output => Parser token output error (Tokens token)+  get_tokens :: (Monoid output) => Parser token output error (Tokens token)   get_tokens =     do-      tokens <- Parser (use #state_tokens)-      Parser (#state_lookahead %= max (current_location tokens))+      tokens <- monad_to_parser get+      update_lookahead (current_location tokens)       return tokens+  monad_to_parser ::+    (+      WriterT output (ExceptT error (MaybeT (StateT (Tokens token) (MaybeT ((,) Location))))) t ->+      Parser token output error t)+  monad_to_parser (WriterT (ExceptT (MaybeT (StateT parse)))) = Parser (\ tokens -> runMaybeT (parse tokens))   -- | Parse the text. You have to provide a function that classifies characters, a function that updates the location after-  -- each character, a tokeniser, a parser and a function that converts parse errors to your preferred type.+  -- each character, a tokeniser, a parser and a function that converts parse errors to your preferred type. Note that if there+  -- is more than one way to successfully parse the text you will get @Nothing@ as the result.   parse' :: forall char_class token error t .     (       (Char -> char_class) ->@@ -162,32 +129,28 @@       Parser' token error t ->       (Location -> error) ->       String ->-      Either Usage_error (Either error t))-  parse' classify_char next_location tokenise_t parse_t parse_error text =+      Maybe (Either error t))+  parse' classify_char next_location tokenise_t parse_t parse_error' text =     runExceptT-      (withExceptT-        transform_error-        (do-          let (end_location, text') = execRWS (classify_chars text) () init_location-          ((), tokens) <- run_parser tokenise_t (Tokens text' end_location)-          fst <$> run_parser parse_t (Tokens tokens end_location)))+      (do+        let (end_location, text') = execRWS (traverse_ classify_char' text) () init_location+        ((), tokens) <- run_parser tokenise_t (Tokens text' end_location)+        fst <$> run_parser parse_t (Tokens tokens end_location))     where-      classify_chars :: String -> RWS () [With_location char_class] Location ()-      classify_chars text' =-        case text' of-          [] -> return ()-          c : text'' ->-            do-              location <- get-              let char_class = classify_char c-              tell [With_location location char_class]-              modify (next_location char_class)-              classify_chars text''-      transform_error :: Parse_error error -> error-      transform_error err =-        case err of-          Filter_error err' -> err'-          Parse_error' location -> parse_error location+      classify_char' :: Char -> RWS () [With_location char_class] Location ()+      classify_char' c =+        do+          location <- get+          let char_class = classify_char c+          tell [With_location location char_class]+          modify (next_location char_class)+      run_parser :: (Monoid output) => Parser token' output error u -> Tokens token' -> ExceptT error Maybe (u, output)+      run_parser parse_u tokens =+        let+          (lookahead, maybe_result) = run_parser' (parse_end parse_u) tokens in+          case maybe_result of+            Nothing -> throwError (parse_error' lookahead)+            Just (result, _) -> ExceptT result   -- | Parse a term in brackets.   parse_brackets :: (Eq token, Monoid output) => token -> token -> Parser token output error t -> Parser token output error t   parse_brackets left_bracket right_bracket parse_t =@@ -197,109 +160,62 @@       parse_token right_bracket       return x   -- | Parse something optional or return the default value.-  parse_default :: Monoid output => Parser token output error t -> t -> Parser token output error t-  parse_default parse_t x = return x <+> parse_t-  parse_directory ::-    Eq token => Parser' token error [Back] -> Parser' token error String -> token -> Parser' token error Directory-  parse_directory parse_back parse_name slash_token =-    Directory <$> parse_back <*> parse_many (parse_one_directory parse_name slash_token)+  parse_default :: (Monoid output) => t -> Parser token output error t -> Parser token output error t+  parse_default x parse_t = return x <+> parse_t   parse_element :: (Eq token, Monoid output) => token -> Parser token output error t -> Parser token output error t   parse_element separator parse_t =     do       parse_token separator       parse_t-  parse_end :: Monoid output => Parser token output error t -> Parser token output error t+  parse_end :: (Monoid output) => Parser token output error t -> Parser token output error t   parse_end parse_t =     do       x <- parse_t       parse_end'       return x-  parse_end' :: Monoid output => Parser token output error ()+  parse_end' :: (Monoid output) => Parser token output error ()   parse_end' =     do       tokens <- get_tokens       case tokens_ended tokens of-        False -> parse_error'+        False -> parse_error         True -> return ()-  parse_error' :: Monoid output => Parser token output error t-  parse_error' =-    do-      lookahead <- Parser (use #state_lookahead)-      Parser (throwError (Parse_error' lookahead))-  -- | Parse a file path. You have to provide a parent directory counter parser, a name parser, the slash token, the dot token,-  -- a function that converts strings to name tokens and the file extension.-  parse_file_path' :: Eq token =>-    (-      Parser' token error [Back] ->-      Parser' token error String ->-      token ->-      token ->-      (String -> token) ->-      String ->-      Parser' token error File_path)-  parse_file_path' parse_back parse_name slash_token dot_token name_token ext =-    do-      directory <- parse_directory parse_back parse_name slash_token-      file_name <- parse_name-      parse_token dot_token-      parse_token (name_token ext)-      return (File_path directory file_name ext)+  parse_error :: (Monoid output) => Parser token output error t+  parse_error = Parser (\ _ -> return Nothing)   -- | Parse a (possibly empty) list with separators.   parse_list :: (Eq token, Monoid output) => token -> Parser token output error t -> Parser token output error [t]-  parse_list separator parse_t = parse_default (parse_non_empty_list separator parse_t) []+  parse_list separator parse_t = parse_default [] (parse_non_empty_list separator parse_t)   -- | Get the current location.-  parse_location :: Monoid output => Parser token output error Location-  parse_location = current_location <$> Parser (use #state_tokens)+  parse_location :: (Monoid output) => Parser token output error Location+  parse_location = current_location <$> monad_to_parser get   -- | Parse a (possibly empty) list without separators.-  parse_many :: Monoid output => Parser token output error t -> Parser token output error [t]-  parse_many parse_t = parse_default (parse_some parse_t) []+  parse_many :: (Monoid output) => Parser token output error t -> Parser token output error [t]+  parse_many parse_t = parse_default [] (parse_some parse_t)   -- | Parse a non-empty list with separators.   parse_non_empty_list :: (Eq token, Monoid output) => token -> Parser token output error t -> Parser token output error [t]   parse_non_empty_list separator parse_t = (:) <$> parse_t <*> parse_many (parse_element separator parse_t)-  -- | Succeed if the parser fails.-  parse_not :: Monoid output => Parser token output error t -> Parser token output error ()-  parse_not (Parser (RWST parse_t)) =-    Parser-      (RWST-        (\ () st ->-          ExceptT-            (do-              result <- runExceptT (parse_t () st)-              case result of-                Left err ->-                  case err of-                    Filter_error _ -> Left Filter_error_encountered_in_parse_not-                    Parse_error' location -> Right (Right ((), st {state_lookahead = location}, mempty))-                Right (_, State _ lookahead', _) -> Right (Left (Parse_error' lookahead')))))-  parse_one_directory :: Eq token => Parser' token error t -> token -> Parser' token error t-  parse_one_directory parse_name slash_token =-    do-      directory <- parse_name-      parse_token slash_token-      return directory   -- | Parse a non-empty list without separators.-  parse_some :: Monoid output => Parser token output error t -> Parser token output error [t]+  parse_some :: (Monoid output) => Parser token output error t -> Parser token output error [t]   parse_some parse_t = (:) <$> parse_t <*> parse_many parse_t   -- | Parse a certain token (for example, a delimiter or a keyword) without returning a result.   parse_token :: (Eq token, Monoid output) => token -> Parser token output error ()   parse_token token = parse_token' (certain_token token)   -- | Parse tokens that fit a certain pattern and transform them into something more useful - for example, an int or a string.-  parse_token' :: Monoid output => (token -> Maybe t) -> Parser token output error t+  parse_token' :: (Monoid output) => (token -> Maybe t) -> Parser token output error t   parse_token' f =     do       tokens <- get_tokens       case take_token f tokens of-        Nothing -> parse_error'+        Nothing -> parse_error         Just (x, tokens') ->           do-            Parser (#state_tokens .= tokens')+            monad_to_parser (put tokens')             return x-  -- | Parse data with location.-  parse_with_location :: Monoid output => Parser token output error t -> Parser token output error (With_location t)-  parse_with_location parse_t = With_location <$> parse_location <*> parse_t-  run_parser :: Monoid output =>-    Parser token output error t -> Tokens token -> ExceptT (Parse_error error) (Either Usage_error) (t, output)-  run_parser parse_t tokens = evalRWST (run_parser' (parse_end parse_t)) () (Parser.Parser.State tokens init_location)+  parser_to_monad ::+    (+      Parser token output error t ->+      WriterT output (ExceptT error (MaybeT (StateT (Tokens token) (MaybeT ((,) Location))))) t)+  parser_to_monad (Parser parse) = WriterT (ExceptT (MaybeT (StateT (\ tokens -> MaybeT (parse tokens)))))   take_token :: (token -> Maybe t) -> Tokens token -> Maybe (t, Tokens token)   take_token f (Tokens tokens end_location) =     case tokens of@@ -307,3 +223,10 @@       With_location _ token : tokens' -> flip (,) (Tokens tokens' end_location) <$> f token   tokens_ended :: Tokens token -> Bool   tokens_ended (Tokens tokens _) = null tokens+  update_lookahead :: (Monoid output) => Location -> Parser token output error ()+  update_lookahead lookahead =+    Parser+      (\ tokens ->+        do+          tell lookahead+          return (Just (Just (Right ((), mempty)), tokens)))

@@ -2,64 +2,23 @@ Description: Assorted utilities.  * Assorted utilities.-* Relative directories and file paths. -} module Parser.Utilities (-  Back (..),-  Directory (..),-  File_path (..),   (<->),-  (<//>),   all_equal,   between,   check,-  check_ext,   construct_map,   construct_set,-  drop_file_name,-  element_at,-  lcm_all,-  read_file,-  swap_either,-  write_file_path) where+  lcm_all) where   import Control.Monad.Except   import Data.Foldable as Foldable-  import Data.List as List   import Data.Map as Map   import Data.Set as Set-  import System.Directory-  -- | Parent directory.-  data Back = Back-  -- | Relative directory.-  data Directory = Directory [Back] [String]-  -- | Relative file path.-  data File_path = File_path Directory String String   -- | Concatenate strings with a whitespace in between.   infixr 5 <->   (<->) :: String -> String -> String   s <-> t = s <> " " <> t-  -- | Prepend a directory to file path.-  infixr 6 <//>-  (<//>) :: Directory -> File_path -> File_path-  directory_0 <//> File_path directory_1 file_name ext = File_path (directory_0 <> directory_1) file_name ext-  deriving instance Eq Back-  deriving instance Eq Directory-  deriving instance Eq File_path-  instance Monoid Directory where-    mempty = Directory [] []-  deriving instance Ord Back-  deriving instance Ord Directory-  deriving instance Ord File_path-  instance Semigroup Directory where-    Directory back_0 directories_0 <> Directory back_1 directories_1 =-      case (Foldable.length directories_0, Foldable.length back_1) of-        (0, 0) -> Directory back_0 directories_1-        (0, _) -> Directory (back_0 <> back_1) directories_1-        (_, 0) -> Directory back_0 (directories_0 <> directories_1)-        (_, _) -> Directory back_0 (init directories_0) <> Directory (List.drop 1 back_1) directories_1-  deriving instance Show Back-  deriving instance Show Directory-  deriving instance Show File_path   -- | Checks if all elements of a list are equal. Returns @Nothing@ if all elements aren't equal, @Just Nothing@ if the list is   -- empty and @Just (Just x)@ if all elements are equal to @x@.   all_equal :: Eq t => [t] -> Maybe (Maybe t)@@ -79,9 +38,6 @@     case condition of       False -> throwError err       True -> return ()-  -- | Check file path extension.-  check_ext :: String -> File_path -> Bool-  check_ext ext (File_path _ _ ext') = ext == ext'   -- | Construct a map if all keys are different. Otherwise return @Nothing@.   construct_map :: Ord t => [(t, u)] -> Maybe (Map t u)   construct_map x =@@ -96,36 +52,22 @@       let y = Set.fromList x       check () (Foldable.length x == Set.size y)       Just y-  -- | Get the directory part of a file path.-  drop_file_name :: File_path -> Directory-  drop_file_name (File_path directory _ _) = directory+{-   -- | Safe list indexation.   element_at :: Int -> [t] -> Maybe t   element_at j x =     do       check () (between 0 (Foldable.length x - 1) j)       return (x !! j)+-}   -- | Aggregate least common denominator.   lcm_all :: (Foldable f, Integral t) => f t -> t   lcm_all = Foldable.foldr lcm 1-  -- | Read a file.-  read_file :: File_path -> IO (Maybe String)-  read_file file_path =-    do-      let file_path' = write_file_path file_path-      pathExists <- doesPathExist file_path'-      case pathExists of-        False -> return Nothing-        True -> Just <$> readFile file_path'+{-   -- | Swap Left and Right.   swap_either :: Either t u -> Either u t   swap_either x =     case x of       Left y -> Right y       Right y -> Left y-  write_back :: Back -> String-  write_back Back = ".."-  -- | Convert a file path to text.-  write_file_path :: File_path -> FilePath-  write_file_path (File_path (Directory back directories) file_name ext) =-    intercalate "/" ((write_back <$> back) <> directories <> [file_name <> "." <> ext])+-}