{-# LANGUAGE DefaultSignatures, FlexibleContexts, FlexibleInstances, TypeFamilies,
TypeOperators, TypeSynonymInstances, UndecidableInstances #-}
module Construct.Classes where
import qualified Rank2
import qualified Text.ParserCombinators.Incremental as Incremental
import Control.Applicative (Alternative ((<|>), empty))
import qualified Data.Attoparsec.ByteString as Attoparsec
import Text.Parser.Input (InputParsing (ParserInput))
class Alternative m => AlternativeFail m where
failure :: String -> m a
expectedName :: String -> m a -> m a
failure = forall a b. a -> b -> a
const forall (f :: * -> *) a. Alternative f => f a
empty
expectedName = forall a b. a -> b -> a
const forall a. a -> a
id
class InputMappableParsing m where
mapParserInput :: (InputParsing (m s), s ~ ParserInput (m s), Monoid s, Monoid s') =>
(s -> s') -> (s' -> s) -> m s a -> m s' a
mapMaybeParserInput :: (InputParsing (m s), s ~ ParserInput (m s), Monoid s, Monoid s') =>
(s -> Maybe s') -> (s' -> Maybe s) -> m s a -> m s' a
class Monad m => FixTraversable m where
fixSequence :: (Rank2.Traversable g, Applicative n) => g m -> m (g n)
fixSequence = forall {k} (g :: (k -> *) -> *) (m :: * -> *) (p :: k -> *)
(q :: k -> *).
(Traversable g, Applicative m) =>
(forall (a :: k). p a -> m (q a)) -> g p -> m (g q)
Rank2.traverse (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
data Error = Error [String] (Maybe String) deriving (Error -> Error -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show)
instance Semigroup Error where
Error [String]
expected1 Maybe String
encountered1 <> :: Error -> Error -> Error
<> Error [String]
expected2 Maybe String
encountered2 =
[String] -> Maybe String -> Error
Error ([String]
expected1 forall a. Semigroup a => a -> a -> a
<> [String]
expected2) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe String
encountered2 forall a. a -> Maybe a
Just Maybe String
encountered1)
instance AlternativeFail Maybe
instance AlternativeFail []
instance {-# OVERLAPS #-} Alternative (Either Error) where
empty :: forall a. Either Error a
empty = forall a b. a -> Either a b
Left ([String] -> Maybe String -> Error
Error [] forall a. Maybe a
Nothing)
Right a
a <|> :: forall a. Either Error a -> Either Error a -> Either Error a
<|> Either Error a
_ = forall a b. b -> Either a b
Right a
a
Either Error a
_ <|> Right a
a = forall a b. b -> Either a b
Right a
a
Left Error
e1 <|> Left Error
e2 = forall a b. a -> Either a b
Left (Error
e1 forall a. Semigroup a => a -> a -> a
<> Error
e2)
instance AlternativeFail (Either Error) where
failure :: forall a. String -> Either Error a
failure String
encountered = forall a b. a -> Either a b
Left ([String] -> Maybe String -> Error
Error [] (forall a. a -> Maybe a
Just String
encountered))
expectedName :: forall a. String -> Either Error a -> Either Error a
expectedName String
expected (Left (Error [String]
_ Maybe String
encountered)) = forall a b. a -> Either a b
Left ([String] -> Maybe String -> Error
Error [String
expected] Maybe String
encountered)
expectedName String
_ Either Error a
success = Either Error a
success
errorString :: Error -> String
errorString :: Error -> String
errorString (Error [String]
ex Maybe String
Nothing) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
"expected " forall a. Semigroup a => a -> a -> a
<>) ([String] -> Maybe String
concatExpected [String]
ex)
errorString (Error [] (Just String
en)) = String
"encountered " forall a. Semigroup a => a -> a -> a
<> String
en
errorString (Error [String]
ex (Just String
en)) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
"expected " forall a. Semigroup a => a -> a -> a
<>) ([String] -> Maybe String
concatExpected [String]
ex) forall a. Semigroup a => a -> a -> a
<> String
", encountered " forall a. Semigroup a => a -> a -> a
<> String
en
concatExpected :: [String] -> Maybe String
concatExpected :: [String] -> Maybe String
concatExpected [] = forall a. Maybe a
Nothing
concatExpected [String
e] = forall a. a -> Maybe a
Just String
e
concatExpected [String
e1, String
e2] = forall a. a -> Maybe a
Just (String
e1 forall a. Semigroup a => a -> a -> a
<> String
" or " forall a. Semigroup a => a -> a -> a
<> String
e2)
concatExpected (String
e:[String]
es) = forall a. a -> Maybe a
Just (String -> [String] -> String
oxfordComma String
e [String]
es)
oxfordComma :: String -> [String] -> String
oxfordComma :: String -> [String] -> String
oxfordComma String
e [] = String
"or " forall a. Semigroup a => a -> a -> a
<> String
e
oxfordComma String
e (String
e':[String]
es) = String
e forall a. Semigroup a => a -> a -> a
<> String
", " forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
oxfordComma String
e' [String]
es
instance FixTraversable Attoparsec.Parser
instance Monoid s => FixTraversable (Incremental.Parser t s) where
fixSequence :: forall (g :: (* -> *) -> *) (n :: * -> *).
(Traversable g, Applicative n) =>
g (Parser t s) -> Parser t s (g n)
fixSequence = forall (g :: (* -> *) -> *) (m :: * -> *) s t.
(Traversable g, Applicative m, Monoid s) =>
g (Parser t s) -> Parser t s (g m)
Incremental.record
instance InputMappableParsing (Incremental.Parser t) where
mapParserInput :: forall s s' a.
(InputParsing (Parser t s), s ~ ParserInput (Parser t s), Monoid s,
Monoid s') =>
(s -> s') -> (s' -> s) -> Parser t s a -> Parser t s' a
mapParserInput = forall s s' t r.
(Monoid s, Monoid s') =>
(s -> s') -> (s' -> s) -> Parser t s r -> Parser t s' r
Incremental.mapInput
mapMaybeParserInput :: forall s s' a.
(InputParsing (Parser t s), s ~ ParserInput (Parser t s), Monoid s,
Monoid s') =>
(s -> Maybe s') -> (s' -> Maybe s) -> Parser t s a -> Parser t s' a
mapMaybeParserInput = forall s s' t r.
(Monoid s, Monoid s') =>
(s -> Maybe s') -> (s' -> Maybe s) -> Parser t s r -> Parser t s' r
Incremental.mapMaybeInput