Kawaii-Parser 2.0.0 → 3.0.0

raw patch · 8 files changed

+510/−497 lines, 8 filesdep +directorydep +generic-lensdep +lensdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: directory, generic-lens, lens

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Kawaii-Parser.cabal +29/−24
• Parser/Errors.hs +0/−11
• Parser/Line_and_char.hs +0/−39
• Parser/Locations.hs +41/−0
• Parser/Parser.hs +309/−242
• Parser/Tokeniser.hs +0/−141
• Parser/Transf.hs +0/−40
• Parser/Utilities.hs +131/−0

@@ -1,25 +1,30 @@-author: Liisi Kerik
-build-type: Simple
-cabal-version: >= 1.10
-category: Monad transformers, Parsing, Tokenisation
-description:
-  This library provides a simple 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 supports adding locations to the parse tree and aims to provide reasonably detailed information about
-  parse errors with minimal user involvement. It also contains a module with type synonyms for some compositions of monad
-  transformers.
-homepage: https://github.com/liisikerik/kawaii_parser
-license: BSD3
-license-file: LICENSE
-maintainer: liisikerik@hotmail.com
-name: Kawaii-Parser
-synopsis: A simple parsing library.
-version: 2.0.0
-library
-  build-depends: base < 4.15, containers, mtl
-  default-language: Haskell2010
-  exposed-modules: Parser.Errors, Parser.Line_and_char, Parser.Parser, Parser.Tokeniser, Parser.Transf
-  other-extensions: StandaloneDeriving
-source-repository head
-  location: https://github.com/liisikerik/kawaii_parser.git
+cabal-version: 3.8+author: Liisi Kerik+category: Parsing, Tokenisation, Utilities+description:+  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.+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+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+  default-language: Haskell2010+  exposed-modules: Parser.Locations, Parser.Parser, Parser.Utilities+  ghc-options: -Wall+source-repository head+  location: https://github.com/liisikerik/kawaii_parser.git   type: git

@@ -1,11 +0,0 @@-{-# OPTIONS_GHC -Wall #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-|
-Description: Errors.
-
-* Errors
--}
-module Parser.Errors (Error (..)) where
-  -- | Errors that indicate that the issue is not with the text but with incorrect use of the parsing library.
-  data Error = Ambiguity | Attempt_to_recover_a_filter_error | Incomplete_tokenisation
-  deriving instance Show Error

@@ -1,39 +0,0 @@-{-# OPTIONS_GHC -Wall #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-|
-Description: Locations.
-
-* Locations
-* Writing locations
--}
-module Parser.Line_and_char (
-  L (..),
-  Line_and_char,
-  init_line_and_char,
-  next_char,
-  next_line,
-  write_file_name_and_line_and_char,
-  write_line_and_char) where
-  -- | Add a location to any type.
-  data L t = L Line_and_char t
-  -- | Locations.
-  data Line_and_char = Line_and_char Integer Integer
-  deriving instance Eq Line_and_char
-  deriving instance Ord Line_and_char
-  deriving instance Show t => Show (L t)
-  deriving instance Show Line_and_char
-  -- | First line, first character.
-  init_line_and_char :: Line_and_char
-  init_line_and_char = Line_and_char 1 1
-  -- | Move one character to the right.
-  next_char :: Line_and_char -> Line_and_char
-  next_char (Line_and_char line char) = Line_and_char line (1 + char)
-  -- | Move to the beginning of the next line.
-  next_line :: Line_and_char -> Line_and_char
-  next_line (Line_and_char line _) = Line_and_char (1 + line) 1
-  -- | Write the location with the file name.
-  write_file_name_and_line_and_char :: String -> Line_and_char -> String
-  write_file_name_and_line_and_char file_name (Line_and_char line char) = file_name ++ ":" ++ show line ++ ":" ++ show char
-  -- | Write the location without a file name.
-  write_line_and_char :: Line_and_char -> String
-  write_line_and_char (Line_and_char line char) = show line ++ ":" ++ show char

@@ -0,0 +1,41 @@+{-|+Description: Locations.++* 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+  -- | First line, first character.+  init_location :: Location+  init_location = Location 1 1+  -- | Move one character to the right.+  next_char :: Location -> Location+  next_char (Location line char) = Location line (1 + char)+  -- | 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,242 +1,309 @@-{-# OPTIONS_GHC -Wall #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-|
-Description: An unambiguous parser with symmetric choice and location tracking.
-
-* Parser
-* Filter
-* Parsing locations
-* Parsing brackets
-* Parsing lists
--}
-module Parser.Parser (
-  (<+>),
-  Parse_error',
-  Parser',
-  add_location,
-  filter_Parser,
-  fmap_filter_Parser,
-  parse,
-  parse_brackets,
-  parse_empty_list,
-  parse_line_and_char,
-  parse_list,
-  parse_many,
-  parse_non_empty_list,
-  parse_some,
-  parse_token,
-  parse_token',
-  write_parse_error) where
-  import Control.Monad.Except (ExceptT (..), MonadError (..), runExceptT, withExceptT)
-  import Control.Monad.State.Strict (MonadState (..), StateT (..), evalStateT, modify)
-  import Data.List (intercalate)
-  import Data.Set (Set, elems, empty, singleton, union)
-  import Parser.Errors (Error (..))
-  import Parser.Line_and_char (L (..), Line_and_char, write_file_name_and_line_and_char)
-  import Parser.Tokeniser (Tokeniser', Tokens', current_line_and_char, get_token, take_token, tokenise, tokens_ended)
-  data Lookahead token = Lookahead Line_and_char (Set String) (Maybe token)
-  -- | Parse errors.
-  data Parse_error' token = Filter_error Line_and_char String | Match_error (Lookahead token)
-  -- | A parser that works on any kind of tokens.
-  newtype Parser' token t = Parser {run_Parser :: StateT (State token) (ExceptT (Parse_error' token) (Either Error)) t}
-  data State token = State {state_tokens :: Tokens' token, state_lookahead :: Lookahead token}
-  infixr 4 ===
-  (===) :: Eq t => t -> t -> t
-  x === y =
-    case x == y of
-      False -> undefined
-      True -> x
-  -- | 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 that, unlike a normal parse error, is not recoverable by backtracking.
-  -- Also note that you should not attempt to recover a filter error. While this operator is normally associative this property
-  -- does not hold when ambiguity errors are involved.
-  infixr 3 <+>
-  (<+>) :: Eq token => Parser' token t -> Parser' token t -> Parser' token t
-  Parser (StateT parse_0) <+> Parser (StateT parse_1) =
-    Parser
-      (StateT
-        (\st ->
-          ExceptT
-            (do
-              (lookahead_0, result_0) <- runExceptT (parse_0 st) >>= deconstruct_result
-              (lookahead_1, result_1) <- runExceptT (parse_1 st) >>= deconstruct_result
-              (
-                construct_result (add_lookaheads 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_line_and_char tokens_0) (current_line_and_char tokens_1) of
-                      LT -> Right result_1
-                      EQ -> Left Ambiguity
-                      GT -> Right result_0))))
-  instance Applicative (Parser' token) where
-    Parser parse_0 <*> Parser parse_1 = Parser (parse_0 <*> parse_1)
-    pure x = Parser (return x)
-  instance Functor (Parser' token) where
-    fmap f (Parser parse') = Parser (f <$> parse')
-  instance Monad (Parser' token) where
-    Parser parse' >>= f = Parser (parse' >>= run_Parser <$> f)
-  deriving instance Show token => Show (Lookahead token)
-  deriving instance Show token => Show (Parse_error' token)
-  deriving instance Show token => Show (State token)
-  -- | Parse something with an added location from the first token.
-  add_location :: Parser' token t -> Parser' token (L t)
-  add_location parse_t = L <$> parse_line_and_char <*> parse_t
-  add_lookaheads :: Eq token => Lookahead token -> Lookahead token -> Lookahead token
-  add_lookaheads
-    (lookahead_0 @ (Lookahead line_and_char_0 expected_0 found_0))
-    (lookahead_1 @ (Lookahead line_and_char_1 expected_1 found_1)) =
-      case compare line_and_char_0 line_and_char_1 of
-        LT -> lookahead_1
-        EQ -> Lookahead (line_and_char_0 === line_and_char_1) (union expected_0 expected_1) (found_0 === found_1)
-        GT -> lookahead_0
-  certain_token :: Eq token => token -> token -> Maybe ()
-  certain_token token token' =
-    case token == token' of
-      False -> Nothing
-      True -> Just ()
-  construct_result :: Lookahead token -> Maybe (t, Tokens' token) -> Either (Parse_error' token) (t, State token)
-  construct_result lookahead result =
-    case result of
-      Nothing -> Left (Match_error lookahead)
-      Just (x, tokens) -> Right (x, State tokens lookahead)
-  deconstruct_result :: Either (Parse_error' token) (t, State token) -> Either Error (Lookahead token, Maybe (t, Tokens' token))
-  deconstruct_result result =
-    case result of
-      Left err ->
-        case err of
-          Filter_error _ _ -> Left Attempt_to_recover_a_filter_error
-          Match_error lookahead -> Right (lookahead, Nothing)
-      Right (x, State tokens lookahead) -> Right (lookahead, Just (x, tokens))
-  -- | Filter the parse results - for example, restrict an integer parser to positive numbers. You also have to provide an error
-  -- string. Note that filter errors, unlike token matching errors, are non-recoverable.
-  filter_Parser :: Ord token => String -> (t -> Bool) -> Parser' token t -> Parser' token t
-  filter_Parser err f =
-    fmap_filter_Parser
-      err
-      (\x ->
-        case f x of
-          False -> Nothing
-          True -> Just x)
-  -- | Filter and transform the parse results. You also have to provide an error string. Note that filter errors, unlike token
-  -- matching errors, are non-recoverable.
-  fmap_filter_Parser :: Ord token => String -> (t -> Maybe u) -> Parser' token t -> Parser' token u
-  fmap_filter_Parser err f parse_t =
-    do
-      line_and_char <- parse_line_and_char
-      x <- parse_t
-      case f x of
-        Nothing -> Parser (throwError (Filter_error line_and_char err))
-        Just y -> return y
-  match_error :: Eq token => String -> Parser' token t
-  match_error expected =
-    do
-      State tokens lookahead <- Parser get
-      Parser
-        (throwError
-          (Match_error
-            (add_lookaheads lookahead (Lookahead (current_line_and_char tokens) (singleton expected) (get_token tokens)))))
-  -- | Parse the text. You have to provide a function that classifies characters, a function that tells how to update the
-  -- location depending on the character, a tokeniser, a parser and a function that converts parse errors to your preferred
-  -- type.
-  parse ::
-    (
-      Eq token => 
-      (Char -> char_class) ->
-      (char_class -> Line_and_char -> Line_and_char) ->
-      Tokeniser' char_class token err () ->
-      Parser' token t ->
-      (Parse_error' token -> err) ->
-      String ->
-      Either Error (Either err t))
-  parse classify_char next_line_and_char tokenise_t parse_t transform_parse_error text =
-    runExceptT
-      (do
-        tokens <- ExceptT (tokenise classify_char next_line_and_char tokenise_t text)
-        withExceptT
-          transform_parse_error
-          (evalStateT
-            (run_Parser (parse_end parse_t))
-            (State tokens (Lookahead (current_line_and_char tokens) empty (get_token tokens)))))
-  -- | Parse a term in brackets.
-  parse_brackets :: Parser' token () -> Parser' token () -> Parser' token t -> Parser' token t
-  parse_brackets parse_left_bracket parse_right_bracket parse_t =
-    do
-      parse_left_bracket
-      x <- parse_t
-      parse_right_bracket
-      return x
-  parse_end :: Eq token => Parser' token t -> Parser' token t
-  parse_end parse_t =
-    do
-      x <- parse_t
-      parse_end'
-      return x
-  parse_end' :: Eq token => Parser' token ()
-  parse_end' =
-    do
-      tokens <- state_tokens <$> Parser get
-      case tokens_ended tokens of
-        False -> match_error "end of text"
-        True -> return ()
-  parse_element :: Parser' token () -> Parser' token t -> Parser' token t
-  parse_element parse_separator parse_t =
-    do
-      parse_separator
-      parse_t
-  -- | Returns an empty list.
-  parse_empty_list :: Parser' token [t]
-  parse_empty_list = pure []
-  -- | Get the current location.
-  parse_line_and_char :: Parser' token Line_and_char
-  parse_line_and_char = current_line_and_char <$> state_tokens <$> Parser get
-  -- | Parse a (possibly empty) list with separators.
-  parse_list :: Eq token => Parser' token () -> Parser' token t -> Parser' token [t]
-  parse_list parse_separator parse_t = parse_empty_list <+> parse_non_empty_list parse_separator parse_t
-  -- | Parse a (possibly empty) list without separators.
-  parse_many :: Eq token => Parser' token t -> Parser' token [t]
-  parse_many parse_t = parse_empty_list <+> parse_some parse_t
-  -- | Parse a non-empty list with separators.
-  parse_non_empty_list :: Eq token => Parser' token () -> Parser' token t -> Parser' token [t]
-  parse_non_empty_list parse_separator parse_t = (:) <$> parse_t <*> parse_many (parse_element parse_separator parse_t)
-  -- | Parse a non-empty list without separators.
-  parse_some :: Eq token => Parser' token t -> Parser' token [t]
-  parse_some parse_t = (:) <$> parse_t <*> parse_many parse_t
-  -- | Parse a certain token (for example, a delimiter or a keyword) without returning any results. You also have to provide a
-  -- string that briefly describes the kind of token that is expected - it is used to provide detailed parse errors.
-  parse_token :: Eq token => token -> String -> Parser' token ()
-  parse_token token = parse_token' (certain_token token)
-  -- | Parses tokens that fit a certain pattern and transforms them into something more useful - for example, a string or an
-  -- integer. You also have to provide a string that briefly describes the kind of token that is expected - it is used to
-  -- provide detailed parse errors.
-  parse_token' :: Eq token => (token -> Maybe t) -> String -> Parser' token t
-  parse_token' f expected =
-    do
-      tokens <- state_tokens <$> Parser get
-      case take_token f tokens of
-        Nothing -> match_error expected
-        Just (x, tokens') ->
-          do
-            Parser (modify (\st -> st {state_tokens = tokens'}))
-            return x
-  write_maybe_token :: (token -> String) -> Maybe token -> String
-  write_maybe_token write_token maybe_token =
-    case maybe_token of
-      Nothing -> "end of file"
-      Just token -> write_token token
-  -- | Write parse errors. You have to provide a function that converts tokens to strings and the file name.
-  write_parse_error :: (token -> String) -> String -> Parse_error' token -> String
-  write_parse_error write_token file_name err =
-    case err of
-      Filter_error line_and_char err' -> err' ++ " at " ++ write_file_name_and_line_and_char file_name line_and_char ++ "."
-      Match_error (Lookahead line_and_char expected found) ->
-        (
-          "Parse error at " ++
-          write_file_name_and_line_and_char file_name line_and_char ++
-          ". Expected [" ++
-          intercalate ", " (elems expected) ++
-          "], found " ++
-          write_maybe_token write_token found ++
-          ".")+{-|+Description: Tokenising and parsing.++* A combinator-based tokeniser with symmetric choice and location tracking.+* An unambiguous parser with symmetric choice and location tracking.+-}+module Parser.Parser (+  Parse_error (..),+  Parser',+  Tokeniser',+  Usage_error (..),+  (<+>),+  add_location,+  add_token,+  filter_parser,+  fmap_filter_parser,+  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+  import Control.Monad.Except+  import Control.Monad.RWS.Strict+  import Data.Generics.Labels ()+  import GHC.Generics+  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}+  -- | 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.+  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) =+    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)+  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+  -- | Parse with location.+  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 ()+  add_token tokenise =+    do+      location <- parse_location+      token <- tokenise+      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.+  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_parser :: (Eq token, Monoid output) =>+    (t -> Bool) -> (Location -> error) -> Parser token output error t -> Parser token output error t+  filter_parser f err =+    fmap_filter_parser+      (\ x ->+        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.+  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 =+    do+      location <- parse_location+      x <- parse_t+      case f x of+        Left err -> Parser (throwError (Filter_error (err location)))+        Right y -> return y+  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))+      return 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.+  parse' :: forall char_class token error t .+    (+      (Char -> char_class) ->+      (char_class -> Location -> Location) ->+      Tokeniser' char_class token error () ->+      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 =+    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)))+    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+  -- | 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 =+    do+      parse_token left_bracket+      x <- parse_t+      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_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 parse_t =+    do+      x <- parse_t+      parse_end'+      return x+  parse_end' :: Monoid output => Parser token output error ()+  parse_end' =+    do+      tokens <- get_tokens+      case tokens_ended tokens of+        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 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) []+  -- | Get the current location.+  parse_location :: Monoid output => Parser token output error Location+  parse_location = current_location <$> Parser (use #state_tokens)+  -- | 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 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 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' f =+    do+      tokens <- get_tokens+      case take_token f tokens of+        Nothing -> parse_error'+        Just (x, tokens') ->+          do+            Parser (#state_tokens .= 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)+  take_token :: (token -> Maybe t) -> Tokens token -> Maybe (t, Tokens token)+  take_token f (Tokens tokens end_location) =+    case tokens of+      [] -> Nothing+      With_location _ token : tokens' -> flip (,) (Tokens tokens' end_location) <$> f token+  tokens_ended :: Tokens token -> Bool+  tokens_ended (Tokens tokens _) = null tokens

@@ -1,141 +0,0 @@-{-# OPTIONS_GHC -Wall #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-|
-Description: A simple state- and transition-based tokeniser with location tracking.
-
-* Tokeniser
--}
-module Parser.Tokeniser (
-  Tokeniser',
-  Tokens',
-  add_token,
-  current_line_and_char,
-  delete_char,
-  gather_token,
-  get_char,
-  get_token,
-  take_token,
-  tokenisation_error,
-  tokenise,
-  tokens_ended) where
-  import Control.Monad.Except (MonadError (..))
-  import Control.Monad.RWS.Strict (RWST, execRWST)
-  import Control.Monad.Reader (MonadReader (..))
-  import Control.Monad.State.Strict (MonadState (..))
-  import Control.Monad.Writer.Strict (MonadWriter (..))
-  import Parser.Errors (Error (..))
-  import Parser.Line_and_char (L (..), Line_and_char, init_line_and_char)
-  data State char_class = State {state_line_and_char :: Line_and_char, state_text :: [char_class]}
-  -- | A tokeniser that works with any kind of custom characters, tokens and errors. The custom character type is useful if you
-  -- need to classify characters according to their behavior before tokenisation - for example, wrap all operators, letters,
-  -- delimiters or digits in the same constructor to simplify pattern matching.
-  data Tokeniser' char_class token err t =
-    Tokeniser {run_tokeniser :: RWST (char_class -> Line_and_char -> Line_and_char) [L token] (State char_class) (Either err) t}
-  -- | A sequence of tokens with locations. For internal use in the parser.
-  data Tokens' token = Tokens [L token] Line_and_char
-  instance Applicative (Tokeniser' char_class token err) where
-    Tokeniser tokenise_0 <*> Tokeniser tokenise_1 = Tokeniser (tokenise_0 <*> tokenise_1)
-    pure x = Tokeniser (return x)
-  instance Functor (Tokeniser' char_class token err) where
-    fmap f (Tokeniser tokenise') = Tokeniser (f <$> tokenise')
-  instance Monad (Tokeniser' char_class token err) where
-    Tokeniser tokenise' >>= f = Tokeniser (tokenise' >>= run_tokeniser <$> f)
-  deriving instance Show char_class => Show (State char_class)
-  deriving instance Show token => Show (Tokens' token)
-  -- | Add the token to the output. Note that the order of adding tokens is important and you have to add the token before
-  -- deleting the respective characters to get the correct location.
-  add_token :: token -> Tokeniser' char_class token err ()
-  add_token token =
-    do
-      line_and_char <- state_line_and_char <$> Tokeniser get
-      add_token' line_and_char token
-  add_token' :: Line_and_char -> token -> Tokeniser' char_class token err ()
-  add_token' line_and_char token = Tokeniser (tell [L line_and_char token])
-  -- | Get the location of the first token or, if there are none, the end of file. For internal use in the parser.
-  current_line_and_char :: Tokens' token -> Line_and_char
-  current_line_and_char (Tokens tokens end_line_and_char) =
-    case tokens of
-      [] -> end_line_and_char
-      L line_and_char _ : _ -> line_and_char
-  -- | Delete the first character from the remaining text. Automatically updates the location.
-  delete_char :: Tokeniser' char_class token err ()
-  delete_char =
-    do
-      next_line_and_char <- Tokeniser ask
-      State line_and_char text <- Tokeniser get
-      case text of
-        [] -> return ()
-        char_class : text' -> Tokeniser (put (State (next_line_and_char char_class line_and_char) text'))
-  -- | Add a token that consists of several characters - for example, an operator, a word or a number. You have to provide a
-  -- function that recognises suitable characters and a function that transforms the resulting string into a token.
-  gather_token :: (char_class -> Maybe Char) -> (String -> token) -> Tokeniser' char_class token err ()
-  gather_token recognise_char string_to_token =
-    do
-      line_and_char <- state_line_and_char <$> Tokeniser get
-      token <- gather_token' recognise_char
-      add_token' line_and_char (string_to_token token)
-  gather_token' :: (char_class -> Maybe Char) -> Tokeniser' char_class token err String
-  gather_token' recognise_char =
-    let
-      f = gather_token' recognise_char
-    in
-      do
-        maybe_char_class <- get_char 0
-        case maybe_char_class >>= recognise_char of
-          Nothing -> return ""
-          Just char ->
-            do
-              delete_char
-              token <- f
-              return (char : token)
-  -- | Take a look at a character without deleting it. Returns @Nothing@ if the index is negative or if the remaining text is
-  -- too short.
-  get_char :: Int -> Tokeniser' char_class token err (Maybe char_class)
-  get_char i =
-    do
-      text <- state_text <$> Tokeniser get
-      return
-        (case 0 <= i && i < length text of
-          False -> Nothing
-          True -> Just (text !! i))
-  -- | Get the first token without deleting it. For internal use in the parser.
-  get_token :: Tokens' token -> Maybe token
-  get_token (Tokens tokens _) =
-    case tokens of
-      [] -> Nothing
-      L _ token : _ -> Just token
-  -- | Recognises tokens that fit a certain pattern and transforms them into something more useful - for example, a string or an
-  -- integer. Returns @Nothing@ if the first token does not fit the pattern, and returns the transformed token and the rest of
-  -- the sequence if it does fit. For internal use in the parser.
-  take_token :: (token -> Maybe t) -> Tokens' token -> Maybe (t, Tokens' token)
-  take_token f (Tokens tokens end_line_and_char) =
-    case tokens of
-      [] -> Nothing
-      L _ token : tokens' ->
-        do
-          x <- f token
-          return (x, Tokens tokens' end_line_and_char)
-  -- | Throw a tokenisation error at the current location.
-  tokenisation_error :: (Line_and_char -> err) -> Tokeniser' char_class token err t
-  tokenisation_error err =
-    do
-      line_and_char <- state_line_and_char <$> Tokeniser get
-      Tokeniser (throwError (err line_and_char))
-  -- | Tokenise the text. For internal use in the parser.
-  tokenise ::
-    (
-      (Char -> char_class) ->
-      (char_class -> Line_and_char -> Line_and_char) ->
-      Tokeniser' char_class token err () ->
-      String ->
-      Either Error (Either err (Tokens' token)))
-  tokenise classify_char next_line_and_char (Tokeniser tokenise') text =
-    case execRWST tokenise' next_line_and_char (State init_line_and_char (classify_char <$> text)) of
-      Left err -> Right (Left err)
-      Right (State line_and_char text', tokens) ->
-        case text' of
-          [] -> Right (Right (Tokens tokens line_and_char))
-          _ -> Left Incomplete_tokenisation
-  -- | Check whether the sequence of tokens has ended. For internal use in the parser.
-  tokens_ended :: Tokens' token -> Bool
-  tokens_ended (Tokens tokens _) = null tokens

@@ -1,40 +0,0 @@-{-# OPTIONS_GHC -Wall #-}
-{-|
-Description: Type synonyms and run functions for pairwise compositions of reader, writer and state transformers.
-
-* RST
-* RWT
-* WST
--}
-module Parser.Transf (RST, RWT, WST, evalRST, evalWST, execRST, execRWT, execWST, runRST, runRWT, runWST) where
-  import Control.Monad.RWS.Strict (RWST (..))
-  -- | The composition of reader and state transformers.
-  type RST env = RWST env ()
-  -- | The composition of reader and writer transformers.
-  type RWT env res = RWST env res ()
-  -- | The composition of writer and state transformers.
-  type WST = RWST ()
-  -- | Discards the end state.
-  evalRST :: Functor f => RST env state f t -> env -> state -> f t
-  evalRST (RWST f) env st = (\(x, _, _) -> x) <$> f env st
-  -- | Discards the end state.
-  evalWST :: Functor f => WST res state f t -> state -> f (t, res)
-  evalWST (RWST f) st = (\(x, _, res) -> (x, res)) <$> f () st
-  -- | Discards the output.
-  execRST :: Functor f => RST env state f t -> env -> state -> f state
-  execRST (RWST f) env st = (\(_, st', _) -> st') <$> f env st
-  -- | Discards the output.
-  execRWT :: Functor f => RWT env res f t -> env -> f res
-  execRWT (RWST f) env = (\(_, (), res) -> res) <$> f env ()
-  -- | Discards the output.
-  execWST :: Functor f => WST res state f t -> state -> f (state, res)
-  execWST (RWST f) st = (\(_, st', res) -> (st', res)) <$> f () st
-  -- | Runs the RS transformer.
-  runRST :: Functor f => RST env state f t -> env -> state -> f (t, state)
-  runRST (RWST f) env st = (\(x, st', ()) -> (x, st')) <$> f env st
-  -- | Runs the RW transformer.
-  runRWT :: Functor f => RWT env res f t -> env -> f (t, res)
-  runRWT (RWST f) env = (\(x, (), res) -> (x, res)) <$> f env ()
-  -- | Runs the WS transformer.
-  runWST :: WST res state f t -> state -> f (t, state, res)
-  runWST (RWST f) = f ()

@@ -0,0 +1,131 @@+{-|+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+  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)+  all_equal x =+    case x of+      [] -> Just Nothing+      y : x' ->+        do+          check () (all ((==) y) x')+          Just (Just y)+  -- | Check if the value is in bounds.+  between :: Ord t => t -> t -> t -> Bool+  between lowest highest x = lowest <= x && highest >= x+  -- | Throw an error if the condition is not satisfied.+  check :: MonadError error f => error -> Bool -> f ()+  check err condition =+    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 =+    do+      let y = Map.fromList x+      check () (Foldable.length x == Map.size y)+      Just y+  -- | Construct a set if all elements are different. Otherwise return @Nothing@.+  construct_set :: Ord t => [t] -> Maybe (Set t)+  construct_set x =+    do+      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])