{-|
Module:     Codec.Parser.Common
Copyright:  Jeremy List
License:    BSD-3
Maintainer: quick.dudley@gmail.com

Common functions which do not need to be in 'Phaser.Core', mostly for using
'Phase's and 'Automaton's as parsers.
-}
{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,CPP #-}
module Codec.Phaser.Common (
  Position(..),
  PhaserType(..),
  Standardized(..),
  Trie,
  newTrie,
  fromTrie,
  satisfy,
  match,
  char,
  iChar,
  string,
  iString,
  (<#>),
  integerDecimal,
  positiveIntegerDecimal,
  decimal,
  scientificNotation,
  directHex,
  hex,
  positiveInteger,
  integer,
  countChar,
  countLine,
  trackPosition,
  normalizeNewlines,
  parse,
  sepBy,
  sepBy1,
  munch,
  munch1,
  parseFile,
  parseHandle,
  latin1
 ) where

import Data.Bits
import Data.Char
import Data.Int
import Data.Word
import Data.Ratio
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup
#endif
import Control.Monad
import Control.Applicative
import qualified Data.Map as M
import System.IO (Handle)

import Codec.Phaser.Core
import qualified Codec.Phaser.ByteString as BP

-- | Class for types which have standardized or otherwise unambiguous
-- representations. Implementations of 'regular' may be more permissive than
-- the corresponding 'Read' instance (if any).
class Standardized r a where
  regular :: Monoid p => Phase p r o a

-- | A data type for describing a position in a text file. Constructor arguments
-- are row number and column number.
data Position = Position
  {-# UNPACK #-}!Int
  {-# UNPACK #-}!Int
 deriving (Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
/= :: Position -> Position -> Bool
Eq,Eq Position
Eq Position =>
(Position -> Position -> Ordering)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Position)
-> (Position -> Position -> Position)
-> Ord Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Position -> Position -> Ordering
compare :: Position -> Position -> Ordering
$c< :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
>= :: Position -> Position -> Bool
$cmax :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
min :: Position -> Position -> Position
Ord)

instance Show Position where
  showsPrec :: Int -> Position -> ShowS
showsPrec Int
p (Position Int
r Int
c) = ShowS -> ShowS
b ShowS
m where
    b :: ShowS -> ShowS
b ShowS
a = if Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
      then (Char
'(' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
')' Char -> ShowS
forall a. a -> [a] -> [a]
:)
      else ShowS
a
    m :: ShowS
m = (String
"Row " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 Int
r ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
", Column " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 Int
c

instance Read Position where
  readsPrec :: Int -> ReadS Position
readsPrec Int
p = Automaton () Char Any Position -> ReadS Position
forall (s :: * -> * -> * -> * -> *) p i o a.
(PhaserType s, Monoid p) =>
s p i o a -> [i] -> [(a, [i])]
toReadS (Phase () Char Any Position -> Automaton () Char Any Position
forall p i o a. Monoid p => Phase p i o a -> Automaton p i o a
forall (s :: * -> * -> * -> * -> *) p i o a.
(PhaserType s, Monoid p) =>
s p i o a -> Automaton p i o a
toAutomaton (Int -> Phase () Char Any Position
forall o. Int -> Phase () Char o Position
go Int
p)) where
    parenthes :: Phase p Char o a -> Phase p Char o a
parenthes Phase p Char o a
a = Phase p Char o a
-> Phase p Char o Char -> Phase p Char o String -> Phase p Char o a
forall p i o a b e.
Phase p i o a -> Phase p i o b -> Phase p i o e -> Phase p i o a
surround Phase p Char o a
a
      (Phase p Char o Char -> Phase p Char o String
forall a. Phase p Char o a -> Phase p Char o [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> Phase p Char o Char
forall p i o. Monoid p => (i -> Bool) -> Phase p i o i
satisfy Char -> Bool
isSpace) Phase p Char o String -> Phase p Char o Char -> Phase p Char o Char
forall a b.
Phase p Char o a -> Phase p Char o b -> Phase p Char o b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Phase p Char o Char
forall p o. Monoid p => Char -> Phase p Char o Char
char Char
'(')
      (Char -> Phase p Char o Char
forall p o. Monoid p => Char -> Phase p Char o Char
char Char
')' Phase p Char o Char
-> Phase p Char o String -> Phase p Char o String
forall a b.
Phase p Char o a -> Phase p Char o b -> Phase p Char o b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Phase p Char o Char -> Phase p Char o String
forall a. Phase p Char o a -> Phase p Char o [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> Phase p Char o Char
forall p i o. Monoid p => (i -> Bool) -> Phase p i o i
satisfy Char -> Bool
isSpace))
    go :: Int -> Phase () Char o Position
    go :: forall o. Int -> Phase () Char o Position
go Int
0 = Phase () Char o Position
forall {o}. Phase () Char o Position
inner Phase () Char o Position
-> Phase () Char o Position -> Phase () Char o Position
forall a.
Phase () Char o a -> Phase () Char o a -> Phase () Char o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Phase () Char o Position -> Phase () Char o Position
forall {p} {o} {a}.
Monoid p =>
Phase p Char o a -> Phase p Char o a
parenthes (Int -> Phase () Char o Position
forall o. Int -> Phase () Char o Position
go Int
0)
    go Int
_ = Phase () Char o Position -> Phase () Char o Position
forall {p} {o} {a}.
Monoid p =>
Phase p Char o a -> Phase p Char o a
parenthes (Int -> Phase () Char o Position
forall o. Int -> Phase () Char o Position
go Int
0)
    inner :: Phase () Char o Position
inner = do
      Phase () Char o Char -> Phase () Char o String
forall a. Phase () Char o a -> Phase () Char o [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> Phase () Char o Char
forall p i o. Monoid p => (i -> Bool) -> Phase p i o i
satisfy Char -> Bool
isSpace)
      String -> Phase () Char o String
forall p o. Monoid p => String -> Phase p Char o String
iString String
"row"
      Phase () Char o Char -> Phase () Char o String
forall a. Phase () Char o a -> Phase () Char o [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ((Char -> Bool) -> Phase () Char o Char
forall p i o. Monoid p => (i -> Bool) -> Phase p i o i
satisfy Char -> Bool
isSpace)
      Int
r <- Phase () Char o Int
forall a p o. (Num a, Monoid p) => Phase p Char o a
integer
      Phase () Char o Char -> Phase () Char o String
forall a. Phase () Char o a -> Phase () Char o [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> Phase () Char o Char
forall p i o. Monoid p => (i -> Bool) -> Phase p i o i
satisfy Char -> Bool
isSpace)
      Char -> Phase () Char o Char
forall p o. Monoid p => Char -> Phase p Char o Char
char Char
','
      Phase () Char o Char -> Phase () Char o String
forall a. Phase () Char o a -> Phase () Char o [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> Phase () Char o Char
forall p i o. Monoid p => (i -> Bool) -> Phase p i o i
satisfy Char -> Bool
isSpace)
      String -> Phase () Char o String
forall p o. Monoid p => String -> Phase p Char o String
iString String
"column"
      Phase () Char o Char -> Phase () Char o String
forall a. Phase () Char o a -> Phase () Char o [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ((Char -> Bool) -> Phase () Char o Char
forall p i o. Monoid p => (i -> Bool) -> Phase p i o i
satisfy Char -> Bool
isSpace)
      Int
c <- Phase () Char o Int
forall a p o. (Num a, Monoid p) => Phase p Char o a
integer
      Position -> Phase () Char o Position
forall a. a -> Phase () Char o a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Position
Position Int
r Int
c)

#if MIN_VERSION_base(4,9,0)
instance Semigroup Position where
  (Position Int
r1 Int
c1) <> :: Position -> Position -> Position
<> (Position Int
r2 Int
c2)
    | Int
r2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0   = Int -> Int -> Position
Position Int
r1 (Int
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c2)
    | Bool
otherwise = Int -> Int -> Position
Position (Int
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r2) Int
c2
#endif

instance Monoid Position where
  mempty :: Position
mempty = Int -> Int -> Position
Position Int
0 Int
0
#if MIN_VERSION_base(4,9,0)
  mappend :: Position -> Position -> Position
mappend = Position -> Position -> Position
forall a. Semigroup a => a -> a -> a
(<>)
#else
  mappend (Position r1 c1) (Position r2 c2)
    | r2 == 0   = Position r1 (c1 + c2)
    | otherwise = Position (r1 + r2) c2
#endif

-- | Tries in this module can be used for creating more efficient parsers
-- when several of the recognized strings begin with the same few characters
data Trie c a = Trie [a] (M.Map c (Trie c a))

instance Ord c => Monoid (Trie c a) where
  mempty :: Trie c a
mempty = [a] -> Map c (Trie c a) -> Trie c a
forall c a. [a] -> Map c (Trie c a) -> Trie c a
Trie [] Map c (Trie c a)
forall k a. Map k a
M.empty
#if MIN_VERSION_base(4,9,0)
  mappend :: Trie c a -> Trie c a -> Trie c a
mappend = Trie c a -> Trie c a -> Trie c a
forall a. Semigroup a => a -> a -> a
(<>)
#else
  mappend ~(Trie l1 m1) ~(Trie l2 m2) =
    Trie (l1 ++ l2) (M.unionWith mappend m1 m2)
#endif

#if MIN_VERSION_base(4,9,0)
instance Ord c => Semigroup (Trie c a) where
  ~(Trie [a]
l1 Map c (Trie c a)
m1) <> :: Trie c a -> Trie c a -> Trie c a
<> ~(Trie [a]
l2 Map c (Trie c a)
m2) =
    [a] -> Map c (Trie c a) -> Trie c a
forall c a. [a] -> Map c (Trie c a) -> Trie c a
Trie ([a]
l1 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
l2) ((Trie c a -> Trie c a -> Trie c a)
-> Map c (Trie c a) -> Map c (Trie c a) -> Map c (Trie c a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith Trie c a -> Trie c a -> Trie c a
forall a. Semigroup a => a -> a -> a
(<>) Map c (Trie c a)
m1 Map c (Trie c a)
m2)
#endif

-- | Consume one input, return it if it matches the predicate, otherwise fail.
satisfy :: (Monoid p) => (i -> Bool) -> Phase p i o i
satisfy :: forall p i o. Monoid p => (i -> Bool) -> Phase p i o i
satisfy i -> Bool
p = Phase p i o i
forall p i o. Phase p i o i
get Phase p i o i -> (i -> Phase p i o i) -> Phase p i o i
forall a b. Phase p i o a -> (a -> Phase p i o b) -> Phase p i o b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \i
c -> if i -> Bool
p i
c then i -> Phase p i o i
forall a. a -> Phase p i o a
forall (m :: * -> *) a. Monad m => a -> m a
return i
c else Phase p i o i
forall a. Phase p i o a
forall (f :: * -> *) a. Alternative f => f a
empty

-- | Consume one input, if it's equal to the parameter then return it, otherwise
-- fail.
match :: (Eq i, Monoid p) => i -> Phase p i o i
match :: forall i p o. (Eq i, Monoid p) => i -> Phase p i o i
match i
t = (i -> Bool) -> Phase p i o i
forall p i o. Monoid p => (i -> Bool) -> Phase p i o i
satisfy (i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
t)

-- | 'match' specialized to 'Char'
char :: (Monoid p) => Char -> Phase p Char o Char
char :: forall p o. Monoid p => Char -> Phase p Char o Char
char = Char -> Phase p Char o Char
forall i p o. (Eq i, Monoid p) => i -> Phase p i o i
match

-- | Case insensitive version of 'char'
iChar :: (Monoid p) => Char -> Phase p Char o Char
iChar :: forall p o. Monoid p => Char -> Phase p Char o Char
iChar Char
t = (Char -> Bool) -> Phase p Char o Char
forall p i o. Monoid p => (i -> Bool) -> Phase p i o i
satisfy (\Char
i -> Char -> Char
toLower Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Char
toLower Char
i)

-- | Match a list of input values
string :: (Eq i, Monoid p) => [i] -> Phase p i o [i]
string :: forall i p o. (Eq i, Monoid p) => [i] -> Phase p i o [i]
string [i]
t = [i] -> Phase p i o [i]
forall {a} {p} {o}. (Eq a, Monoid p) => [a] -> Phase p a o [i]
go [i]
t where
  go :: [a] -> Phase p a o [i]
go [] = [i] -> Phase p a o [i]
forall a. a -> Phase p a o a
forall (m :: * -> *) a. Monad m => a -> m a
return [i]
t
  go (a
a:[a]
r) = Phase p a o a
forall p i o. Phase p i o i
get Phase p a o a -> (a -> Phase p a o [i]) -> Phase p a o [i]
forall a b. Phase p a o a -> (a -> Phase p a o b) -> Phase p a o b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
c -> if a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a then [a] -> Phase p a o [i]
go [a]
r else Phase p a o [i]
forall a. Phase p a o a
forall (f :: * -> *) a. Alternative f => f a
empty

-- | Match a string (case insensitive)
iString :: (Monoid p) => String -> Phase p Char o String
iString :: forall p o. Monoid p => String -> Phase p Char o String
iString = (Char -> Phase p Char o Char) -> String -> Phase p Char o String
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Char -> Phase p Char o Char
forall p o. Monoid p => Char -> Phase p Char o Char
iChar

infixl 5 <#>
(<#>) :: (PhaserType d, PhaserType s, Monoid p) =>
     s p b c (a -> z) -> d p c t a -> Automaton p b t z
<#> :: forall (d :: * -> * -> * -> * -> *) (s :: * -> * -> * -> * -> *) p
       b c a z t.
(PhaserType d, PhaserType s, Monoid p) =>
s p b c (a -> z) -> d p c t a -> Automaton p b t z
(<#>) = ((a -> z) -> a -> z)
-> s p b c (a -> z) -> d p c t a -> Automaton p b t z
forall p (s :: * -> * -> * -> * -> *) (d :: * -> * -> * -> * -> *)
       x a z b t c.
(Monoid p, PhaserType s, PhaserType d) =>
(x -> a -> z) -> s p b c x -> d p c t a -> Automaton p b t z
chainWith (a -> z) -> a -> z
forall a b. (a -> b) -> a -> b
($)

-- | Parse a standard positive base 10 integer
positiveIntegerDecimal :: (Num a, Monoid p) => Phase p Char o a
positiveIntegerDecimal :: forall a p o. (Num a, Monoid p) => Phase p Char o a
positiveIntegerDecimal = a -> Phase p Char o a
forall {p} {b} {o}. (Monoid p, Num b) => b -> Phase p Char o b
go a
0 where
  go :: b -> Phase p Char o b
go b
acc = do
    b
d <- (Char -> b) -> Phase p Char o Char -> Phase p Char o b
forall a b. (a -> b) -> Phase p Char o a -> Phase p Char o b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> (Char -> Int) -> Char -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt) (Phase p Char o Char -> Phase p Char o b)
-> Phase p Char o Char -> Phase p Char o b
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Phase p Char o Char
forall p i o. Monoid p => (i -> Bool) -> Phase p i o i
satisfy Char -> Bool
isDigit
    let acc' :: b
acc' = b
acc b -> b -> b
forall a. Num a => a -> a -> a
* b
10 b -> b -> b
forall a. Num a => a -> a -> a
+ b
d
    b
acc' b -> Phase p Char o b -> Phase p Char o b
forall a b. a -> b -> b
`seq` b -> Phase p Char o b
go b
acc' Phase p Char o b -> Phase p Char o b -> Phase p Char o b
forall a. Phase p Char o a -> Phase p Char o a -> Phase p Char o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> b -> Phase p Char o b
forall a. a -> Phase p Char o a
forall (m :: * -> *) a. Monad m => a -> m a
return b
acc'

-- | Parse a standard base 10 integer
integerDecimal :: (Num a, Monoid p) => Phase p Char o a
integerDecimal :: forall a p o. (Num a, Monoid p) => Phase p Char o a
integerDecimal = ((a -> a) -> Phase p Char o (a -> a)
forall a. a -> Phase p Char o a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id Phase p Char o (a -> a)
-> Phase p Char o (a -> a) -> Phase p Char o (a -> a)
forall a. Phase p Char o a -> Phase p Char o a -> Phase p Char o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Phase p Char o Char
forall p o. Monoid p => Char -> Phase p Char o Char
char Char
'-' Phase p Char o Char
-> Phase p Char o String -> Phase p Char o String
forall a b.
Phase p Char o a -> Phase p Char o b -> Phase p Char o b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Phase p Char o String
forall p i o. Monoid p => (i -> Bool) -> Phase p i o [i]
munch Char -> Bool
isSpace Phase p Char o String
-> Phase p Char o (a -> a) -> Phase p Char o (a -> a)
forall a b.
Phase p Char o a -> Phase p Char o b -> Phase p Char o b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (a -> a) -> Phase p Char o (a -> a)
forall a. a -> Phase p Char o a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. Num a => a -> a
negate)) Phase p Char o (a -> a) -> Phase p Char o a -> Phase p Char o a
forall a b.
Phase p Char o (a -> b) -> Phase p Char o a -> Phase p Char o b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  Phase p Char o a
forall a p o. (Num a, Monoid p) => Phase p Char o a
positiveIntegerDecimal

-- | Take some hexadecimal digits and parse a number from hexadecimal
directHex :: (Num a, Monoid p) => Phase p Char o a
directHex :: forall a p o. (Num a, Monoid p) => Phase p Char o a
directHex = a -> Phase p Char o a
forall {p} {b} {o}. (Monoid p, Num b) => b -> Phase p Char o b
go a
0 where
  go :: b -> Phase p Char o b
go b
acc = do
    b
d <- (Char -> b) -> Phase p Char o Char -> Phase p Char o b
forall a b. (a -> b) -> Phase p Char o a -> Phase p Char o b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> (Char -> Int) -> Char -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt) (Phase p Char o Char -> Phase p Char o b)
-> Phase p Char o Char -> Phase p Char o b
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Phase p Char o Char
forall p i o. Monoid p => (i -> Bool) -> Phase p i o i
satisfy Char -> Bool
isHexDigit
    let acc' :: b
acc' = b
acc b -> b -> b
forall a. Num a => a -> a -> a
* b
16 b -> b -> b
forall a. Num a => a -> a -> a
+ b
d
    b
acc' b -> Phase p Char o b -> Phase p Char o b
forall a b. a -> b -> b
`seq` b -> Phase p Char o b
go b
acc' Phase p Char o b -> Phase p Char o b -> Phase p Char o b
forall a. Phase p Char o a -> Phase p Char o a -> Phase p Char o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> b -> Phase p Char o b
forall a. a -> Phase p Char o a
forall (m :: * -> *) a. Monad m => a -> m a
return b
acc'

-- | Parse a hexadecimal number prefixed with "Ox"
hex :: (Num a, Monoid p) => Phase p Char o a
hex :: forall a p o. (Num a, Monoid p) => Phase p Char o a
hex = String -> Phase p Char o String
forall i p o. (Eq i, Monoid p) => [i] -> Phase p i o [i]
string String
"0x" Phase p Char o String -> Phase p Char o a -> Phase p Char o a
forall a b.
Phase p Char o a -> Phase p Char o b -> Phase p Char o b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Phase p Char o a
forall a p o. (Num a, Monoid p) => Phase p Char o a
directHex

-- | Parse a positive integer from either decimal or hexadecimal format
positiveInteger :: (Num a, Monoid p) => Phase p Char o a
positiveInteger :: forall a p o. (Num a, Monoid p) => Phase p Char o a
positiveInteger = Phase p Char o a
forall a p o. (Num a, Monoid p) => Phase p Char o a
positiveIntegerDecimal Phase p Char o a -> Phase p Char o a -> Phase p Char o a
forall a. Phase p Char o a -> Phase p Char o a -> Phase p Char o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Phase p Char o a
forall a p o. (Num a, Monoid p) => Phase p Char o a
hex

-- | Parse a number either from decimal digits or from hexadecimal prefixed with
-- "0x"
integer :: (Num a, Monoid p) => Phase p Char o a
integer :: forall a p o. (Num a, Monoid p) => Phase p Char o a
integer = Phase p Char o a
forall a p o. (Num a, Monoid p) => Phase p Char o a
integerDecimal Phase p Char o a -> Phase p Char o a -> Phase p Char o a
forall a. Phase p Char o a -> Phase p Char o a -> Phase p Char o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Phase p Char o a
forall a p o. (Num a, Monoid p) => Phase p Char o a
hex

-- | Parse a number from decimal digits, "-", and "."
decimal :: (Fractional a, Monoid p) => Phase p Char o a
decimal :: forall a p o. (Fractional a, Monoid p) => Phase p Char o a
decimal = ((a -> a) -> Phase p Char o (a -> a)
forall a. a -> Phase p Char o a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id Phase p Char o (a -> a)
-> Phase p Char o (a -> a) -> Phase p Char o (a -> a)
forall a. Phase p Char o a -> Phase p Char o a -> Phase p Char o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> a
forall a. Num a => a -> a
negate (a -> a) -> Phase p Char o Char -> Phase p Char o (a -> a)
forall a b. a -> Phase p Char o b -> Phase p Char o a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Phase p Char o Char
forall p o. Monoid p => Char -> Phase p Char o Char
char Char
'-' Phase p Char o (a -> a)
-> Phase p Char o String -> Phase p Char o (a -> a)
forall a b.
Phase p Char o a -> Phase p Char o b -> Phase p Char o a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Phase p Char o String
forall p i o. Monoid p => (i -> Bool) -> Phase p i o [i]
munch Char -> Bool
isSpace)) Phase p Char o (a -> a) -> Phase p Char o a -> Phase p Char o a
forall a b.
Phase p Char o (a -> b) -> Phase p Char o a -> Phase p Char o b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  Phase p Char o a
forall a p o. (Fractional a, Monoid p) => Phase p Char o a
positiveDecimal

-- | Parse a positive number from decimal digits and "."
positiveDecimal :: (Fractional a, Monoid p) => Phase p Char o a
positiveDecimal :: forall a p o. (Fractional a, Monoid p) => Phase p Char o a
positiveDecimal = Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Rational -> a) -> Phase p Char o Rational -> Phase p Char o a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  Rational
w <- Phase p Char o Rational
forall a p o. (Num a, Monoid p) => Phase p Char o a
positiveIntegerDecimal
  (Char -> Phase p Char o Char
forall i p o. (Eq i, Monoid p) => i -> Phase p i o i
match Char
'.' Phase p Char o Char
-> Phase p Char o Rational -> Phase p Char o Rational
forall a b.
Phase p Char o a -> Phase p Char o b -> Phase p Char o b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Rational -> Rational -> Phase p Char o Rational
forall {p} {b} {o}.
(Monoid p, Fractional b) =>
Bool -> b -> b -> Phase p Char o b
go Bool
True Rational
0.1 Rational
w) Phase p Char o Rational
-> Phase p Char o Rational -> Phase p Char o Rational
forall a. Phase p Char o a -> Phase p Char o a -> Phase p Char o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Rational -> Phase p Char o Rational
forall a. a -> Phase p Char o a
forall (m :: * -> *) a. Monad m => a -> m a
return Rational
w
 where
  go :: Bool -> b -> b -> Phase p Char o b
go Bool
i b
s b
acc = do
    let
     p :: Phase p i o a -> Phase p i o a
p = if Bool
i
      then (String
"At least one digit required after decimal point" String -> Phase p i o a -> Phase p i o a
forall {p} {i} {o} {a}. String -> Phase p i o a -> Phase p i o a
<?>)
      else Phase p i o a -> Phase p i o a
forall a. a -> a
id
    b
d <- Phase p Char o b -> Phase p Char o b
forall {p} {i} {o} {a}. Phase p i o a -> Phase p i o a
p (Phase p Char o b -> Phase p Char o b)
-> Phase p Char o b -> Phase p Char o b
forall a b. (a -> b) -> a -> b
$ (Char -> b) -> Phase p Char o Char -> Phase p Char o b
forall a b. (a -> b) -> Phase p Char o a -> Phase p Char o b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> (Char -> Int) -> Char -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt) (Phase p Char o Char -> Phase p Char o b)
-> Phase p Char o Char -> Phase p Char o b
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Phase p Char o Char
forall p i o. Monoid p => (i -> Bool) -> Phase p i o i
satisfy Char -> Bool
isDigit
    let acc' :: b
acc' = b
acc b -> b -> b
forall a. Num a => a -> a -> a
+ b
d b -> b -> b
forall a. Num a => a -> a -> a
* b
s
    b
acc' b -> Phase p Char o b -> Phase p Char o b
forall a b. a -> b -> b
`seq` Bool -> b -> b -> Phase p Char o b
go Bool
False (b
s b -> b -> b
forall a. Fractional a => a -> a -> a
/ b
10) b
acc' Phase p Char o b -> Phase p Char o b -> Phase p Char o b
forall a. Phase p Char o a -> Phase p Char o a -> Phase p Char o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> b -> Phase p Char o b
forall a. a -> Phase p Char o a
forall (m :: * -> *) a. Monad m => a -> m a
return b
acc'

-- | Parse a number from standard decimal format or from scientific notation.
scientificNotation :: (Fractional a, Monoid p) => Phase p Char o a
scientificNotation :: forall a p o. (Fractional a, Monoid p) => Phase p Char o a
scientificNotation = (Rational -> a) -> Phase p Char o Rational -> Phase p Char o a
forall a b. (a -> b) -> Phase p Char o a -> Phase p Char o b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Phase p Char o Rational -> Phase p Char o a)
-> Phase p Char o Rational -> Phase p Char o a
forall a b. (a -> b) -> a -> b
$ ((Rational -> Rational) -> Rational -> Rational)
-> Rational -> (Rational -> Rational) -> Rational
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Rational -> Rational) -> Rational -> Rational
forall a. a -> a
id (Rational -> (Rational -> Rational) -> Rational)
-> Phase p Char o Rational
-> Phase p Char o ((Rational -> Rational) -> Rational)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Phase p Char o Rational
forall a p o. (Fractional a, Monoid p) => Phase p Char o a
decimal Phase p Char o ((Rational -> Rational) -> Rational)
-> Phase p Char o (Rational -> Rational) -> Phase p Char o Rational
forall a b.
Phase p Char o (a -> b) -> Phase p Char o a -> Phase p Char o b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Rational -> Rational) -> Phase p Char o (Rational -> Rational)
forall a. a -> Phase p Char o a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rational -> Rational
forall a. a -> a
id Phase p Char o (Rational -> Rational)
-> Phase p Char o (Rational -> Rational)
-> Phase p Char o (Rational -> Rational)
forall a. Phase p Char o a -> Phase p Char o a -> Phase p Char o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (
  (\Rational -> Rational -> Rational
o Integer
p Rational
n -> Rational -> Rational -> Rational
o Rational
n (Rational
10 Rational -> Integer -> Rational
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
p)) ((Rational -> Rational -> Rational)
 -> Integer -> Rational -> Rational)
-> Phase p Char o (Rational -> Rational -> Rational)
-> Phase p Char o (Integer -> Rational -> Rational)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Phase p Char o Char
forall p o. Monoid p => Char -> Phase p Char o Char
iChar Char
'e' Phase p Char o Char
-> Phase p Char o (Rational -> Rational -> Rational)
-> Phase p Char o (Rational -> Rational -> Rational)
forall a b.
Phase p Char o a -> Phase p Char o b -> Phase p Char o b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
    ((Rational -> Rational -> Rational)
-> Phase p Char o (Rational -> Rational -> Rational)
forall a. a -> Phase p Char o a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(*) Phase p Char o (Rational -> Rational -> Rational)
-> Phase p Char o (Rational -> Rational -> Rational)
-> Phase p Char o (Rational -> Rational -> Rational)
forall a. Phase p Char o a -> Phase p Char o a -> Phase p Char o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(*) (Rational -> Rational -> Rational)
-> Phase p Char o Char
-> Phase p Char o (Rational -> Rational -> Rational)
forall a b. a -> Phase p Char o b -> Phase p Char o a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Phase p Char o Char
forall p o. Monoid p => Char -> Phase p Char o Char
char Char
'+') Phase p Char o (Rational -> Rational -> Rational)
-> Phase p Char o (Rational -> Rational -> Rational)
-> Phase p Char o (Rational -> Rational -> Rational)
forall a. Phase p Char o a -> Phase p Char o a -> Phase p Char o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
(/) (Rational -> Rational -> Rational)
-> Phase p Char o Char
-> Phase p Char o (Rational -> Rational -> Rational)
forall a b. a -> Phase p Char o b -> Phase p Char o a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Phase p Char o Char
forall p o. Monoid p => Char -> Phase p Char o Char
char Char
'-'))) Phase p Char o (Integer -> Rational -> Rational)
-> Phase p Char o Integer -> Phase p Char o (Rational -> Rational)
forall a b.
Phase p Char o (a -> b) -> Phase p Char o a -> Phase p Char o b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Phase p Char o Integer
forall a p o. (Num a, Monoid p) => Phase p Char o a
positiveIntegerDecimal
 ))

-- | Move the position counter one character to the right
countChar :: Phase Position i o ()
{-# INLINE countChar #-}
countChar :: forall i o. Phase Position i o ()
countChar = Position -> Phase Position i o ()
forall p i o. p -> Phase p i o ()
count (Int -> Int -> Position
Position Int
0 Int
1)

-- | Move the position counter to the next line
countLine :: Phase Position i o ()
{-# INLINE countLine #-}
countLine :: forall i o. Phase Position i o ()
countLine = Position -> Phase Position i o ()
forall p i o. p -> Phase p i o ()
count (Int -> Int -> Position
Position Int
1 Int
1)

-- | Count the lines and characters from the input before yielding them again.
-- If the phase pipeline does not include this or similar: parsing errors will
-- not report the correct position. Unix, Windows, Mac-OS Classic, and Acorn
-- newline formats are all recognized.
trackPosition :: Phase Position Char Char ()
{-# INLINABLE[1] trackPosition #-}
trackPosition :: Phase Position Char Char ()
trackPosition = Phase Position Char Char ()
go where
  go :: Phase Position Char Char ()
go = (Phase Position Char Char ()
 -> Phase Position Char Char () -> Phase Position Char Char ())
-> Phase Position Char Char ()
-> Phase Position Char Char ()
-> Phase Position Char Char ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Phase Position Char Char ()
-> Phase Position Char Char () -> Phase Position Char Char ()
forall a.
Phase Position Char Char a
-> Phase Position Char Char a -> Phase Position Char Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (() -> Phase Position Char Char ()
forall a. a -> Phase Position Char Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Phase Position Char Char () -> Phase Position Char Char ())
-> Phase Position Char Char () -> Phase Position Char Char ()
forall a b. (a -> b) -> a -> b
$ Phase Position Char Char Char
forall p i o. Phase p i o i
get Phase Position Char Char Char
-> (Char -> Phase Position Char Char ())
-> Phase Position Char Char ()
forall a b.
Phase Position Char Char a
-> (a -> Phase Position Char Char b) -> Phase Position Char Char b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c -> Char -> Phase Position Char Char ()
forall o p i. o -> Phase p i o ()
yield Char
c Phase Position Char Char ()
-> Phase Position Char Char () -> Phase Position Char Char ()
forall a b.
Phase Position Char Char a
-> Phase Position Char Char b -> Phase Position Char Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> case Char
c of
    Char
'\n' -> Phase Position Char Char ()
forall i o. Phase Position i o ()
countLine Phase Position Char Char ()
-> Phase Position Char Char () -> Phase Position Char Char ()
forall a b.
Phase Position Char Char a
-> Phase Position Char Char b -> Phase Position Char Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Phase Position Char Char ()
goN
    Char
'\r' -> Phase Position Char Char ()
forall i o. Phase Position i o ()
countLine Phase Position Char Char ()
-> Phase Position Char Char () -> Phase Position Char Char ()
forall a b.
Phase Position Char Char a
-> Phase Position Char Char b -> Phase Position Char Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Phase Position Char Char ()
goR
    Char
_ -> Phase Position Char Char ()
forall i o. Phase Position i o ()
countChar Phase Position Char Char ()
-> Phase Position Char Char () -> Phase Position Char Char ()
forall a b.
Phase Position Char Char a
-> Phase Position Char Char b -> Phase Position Char Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Phase Position Char Char ()
go
  goN :: Phase Position Char Char ()
goN = (Phase Position Char Char ()
 -> Phase Position Char Char () -> Phase Position Char Char ())
-> Phase Position Char Char ()
-> Phase Position Char Char ()
-> Phase Position Char Char ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Phase Position Char Char ()
-> Phase Position Char Char () -> Phase Position Char Char ()
forall a.
Phase Position Char Char a
-> Phase Position Char Char a -> Phase Position Char Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (() -> Phase Position Char Char ()
forall a. a -> Phase Position Char Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Phase Position Char Char () -> Phase Position Char Char ())
-> Phase Position Char Char () -> Phase Position Char Char ()
forall a b. (a -> b) -> a -> b
$ Phase Position Char Char Char
forall p i o. Phase p i o i
get Phase Position Char Char Char
-> (Char -> Phase Position Char Char ())
-> Phase Position Char Char ()
forall a b.
Phase Position Char Char a
-> (a -> Phase Position Char Char b) -> Phase Position Char Char b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c -> Char -> Phase Position Char Char ()
forall o p i. o -> Phase p i o ()
yield Char
c Phase Position Char Char ()
-> Phase Position Char Char () -> Phase Position Char Char ()
forall a b.
Phase Position Char Char a
-> Phase Position Char Char b -> Phase Position Char Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> case Char
c of
    Char
'\n' -> Phase Position Char Char ()
forall i o. Phase Position i o ()
countLine Phase Position Char Char ()
-> Phase Position Char Char () -> Phase Position Char Char ()
forall a b.
Phase Position Char Char a
-> Phase Position Char Char b -> Phase Position Char Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Phase Position Char Char ()
goN
    Char
'\r' -> Phase Position Char Char ()
go
    Char
_ -> Phase Position Char Char ()
forall i o. Phase Position i o ()
countChar Phase Position Char Char ()
-> Phase Position Char Char () -> Phase Position Char Char ()
forall a b.
Phase Position Char Char a
-> Phase Position Char Char b -> Phase Position Char Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Phase Position Char Char ()
go
  goR :: Phase Position Char Char ()
goR = (Phase Position Char Char ()
 -> Phase Position Char Char () -> Phase Position Char Char ())
-> Phase Position Char Char ()
-> Phase Position Char Char ()
-> Phase Position Char Char ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Phase Position Char Char ()
-> Phase Position Char Char () -> Phase Position Char Char ()
forall a.
Phase Position Char Char a
-> Phase Position Char Char a -> Phase Position Char Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (() -> Phase Position Char Char ()
forall a. a -> Phase Position Char Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Phase Position Char Char () -> Phase Position Char Char ())
-> Phase Position Char Char () -> Phase Position Char Char ()
forall a b. (a -> b) -> a -> b
$ Phase Position Char Char Char
forall p i o. Phase p i o i
get Phase Position Char Char Char
-> (Char -> Phase Position Char Char ())
-> Phase Position Char Char ()
forall a b.
Phase Position Char Char a
-> (a -> Phase Position Char Char b) -> Phase Position Char Char b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c -> Char -> Phase Position Char Char ()
forall o p i. o -> Phase p i o ()
yield Char
c Phase Position Char Char ()
-> Phase Position Char Char () -> Phase Position Char Char ()
forall a b.
Phase Position Char Char a
-> Phase Position Char Char b -> Phase Position Char Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> case Char
c of
    Char
'\n' -> Phase Position Char Char ()
go
    Char
'\r' -> Phase Position Char Char ()
forall i o. Phase Position i o ()
countLine Phase Position Char Char ()
-> Phase Position Char Char () -> Phase Position Char Char ()
forall a b.
Phase Position Char Char a
-> Phase Position Char Char b -> Phase Position Char Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Phase Position Char Char ()
goR
    Char
_ -> Phase Position Char Char ()
forall i o. Phase Position i o ()
countChar Phase Position Char Char ()
-> Phase Position Char Char () -> Phase Position Char Char ()
forall a b.
Phase Position Char Char a
-> Phase Position Char Char b -> Phase Position Char Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Phase Position Char Char ()
go

-- | Converts all line separators into Unix format.
normalizeNewlines :: Monoid p => Phase p Char Char ()
normalizeNewlines :: forall p. Monoid p => Phase p Char Char ()
normalizeNewlines = Phase p Char Char ()
go where
  go :: Phase p Char Char ()
go = (Phase p Char Char ()
 -> Phase p Char Char () -> Phase p Char Char ())
-> Phase p Char Char ()
-> Phase p Char Char ()
-> Phase p Char Char ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Phase p Char Char ()
-> Phase p Char Char () -> Phase p Char Char ()
forall a.
Phase p Char Char a -> Phase p Char Char a -> Phase p Char Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (() -> Phase p Char Char ()
forall a. a -> Phase p Char Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Phase p Char Char () -> Phase p Char Char ())
-> Phase p Char Char () -> Phase p Char Char ()
forall a b. (a -> b) -> a -> b
$ Phase p Char Char Char
forall p i o. Phase p i o i
get Phase p Char Char Char
-> (Char -> Phase p Char Char ()) -> Phase p Char Char ()
forall a b.
Phase p Char Char a
-> (a -> Phase p Char Char b) -> Phase p Char Char b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c -> case Char
c of
    Char
'\n' -> Char -> Phase p Char Char ()
forall o p i. o -> Phase p i o ()
yield Char
'\n' Phase p Char Char ()
-> Phase p Char Char () -> Phase p Char Char ()
forall a b.
Phase p Char Char a -> Phase p Char Char b -> Phase p Char Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Phase p Char Char ()
goN
    Char
'\r' -> Char -> Phase p Char Char ()
forall o p i. o -> Phase p i o ()
yield Char
'\n' Phase p Char Char ()
-> Phase p Char Char () -> Phase p Char Char ()
forall a b.
Phase p Char Char a -> Phase p Char Char b -> Phase p Char Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Phase p Char Char ()
goR
    Char
_ -> Char -> Phase p Char Char ()
forall o p i. o -> Phase p i o ()
yield Char
c Phase p Char Char ()
-> Phase p Char Char () -> Phase p Char Char ()
forall a b.
Phase p Char Char a -> Phase p Char Char b -> Phase p Char Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Phase p Char Char ()
go
  goN :: Phase p Char Char ()
goN = (Phase p Char Char ()
 -> Phase p Char Char () -> Phase p Char Char ())
-> Phase p Char Char ()
-> Phase p Char Char ()
-> Phase p Char Char ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Phase p Char Char ()
-> Phase p Char Char () -> Phase p Char Char ()
forall a.
Phase p Char Char a -> Phase p Char Char a -> Phase p Char Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (() -> Phase p Char Char ()
forall a. a -> Phase p Char Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Phase p Char Char () -> Phase p Char Char ())
-> Phase p Char Char () -> Phase p Char Char ()
forall a b. (a -> b) -> a -> b
$ Phase p Char Char Char
forall p i o. Phase p i o i
get Phase p Char Char Char
-> (Char -> Phase p Char Char ()) -> Phase p Char Char ()
forall a b.
Phase p Char Char a
-> (a -> Phase p Char Char b) -> Phase p Char Char b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c -> case Char
c of
    Char
'\n' -> Char -> Phase p Char Char ()
forall o p i. o -> Phase p i o ()
yield Char
'\n' Phase p Char Char ()
-> Phase p Char Char () -> Phase p Char Char ()
forall a b.
Phase p Char Char a -> Phase p Char Char b -> Phase p Char Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Phase p Char Char ()
goN
    Char
'\r' -> Phase p Char Char ()
go
    Char
_ -> Char -> Phase p Char Char ()
forall o p i. o -> Phase p i o ()
yield Char
c Phase p Char Char ()
-> Phase p Char Char () -> Phase p Char Char ()
forall a b.
Phase p Char Char a -> Phase p Char Char b -> Phase p Char Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Phase p Char Char ()
go
  goR :: Phase p Char Char ()
goR = (Phase p Char Char ()
 -> Phase p Char Char () -> Phase p Char Char ())
-> Phase p Char Char ()
-> Phase p Char Char ()
-> Phase p Char Char ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Phase p Char Char ()
-> Phase p Char Char () -> Phase p Char Char ()
forall a.
Phase p Char Char a -> Phase p Char Char a -> Phase p Char Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (() -> Phase p Char Char ()
forall a. a -> Phase p Char Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Phase p Char Char () -> Phase p Char Char ())
-> Phase p Char Char () -> Phase p Char Char ()
forall a b. (a -> b) -> a -> b
$ Phase p Char Char Char
forall p i o. Phase p i o i
get Phase p Char Char Char
-> (Char -> Phase p Char Char ()) -> Phase p Char Char ()
forall a b.
Phase p Char Char a
-> (a -> Phase p Char Char b) -> Phase p Char Char b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c -> case Char
c of
    Char
'\n' -> Phase p Char Char ()
go
    Char
'\r' -> Char -> Phase p Char Char ()
forall o p i. o -> Phase p i o ()
yield Char
'\n' Phase p Char Char ()
-> Phase p Char Char () -> Phase p Char Char ()
forall a b.
Phase p Char Char a -> Phase p Char Char b -> Phase p Char Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Phase p Char Char ()
goR
    Char
_ -> Char -> Phase p Char Char ()
forall o p i. o -> Phase p i o ()
yield Char
c Phase p Char Char ()
-> Phase p Char Char () -> Phase p Char Char ()
forall a b.
Phase p Char Char a -> Phase p Char Char b -> Phase p Char Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Phase p Char Char ()
go

-- | Use a 'Phase' as a parser. Note that unlike other parsers the reported
-- position in the input when the parser fails is the position reached when
-- all parsing options are exhausted, not the beginning of the failing token.
-- Since the characters may be counted nondeterministically: if multiple errors
-- are returned the reported error position may be different for each error
-- report.
parse :: (PhaserType s) => s Position i o a -> [i] -> Either [(Position,[String])] [a]
parse :: forall (s :: * -> * -> * -> * -> *) i o a.
PhaserType s =>
s Position i o a -> [i] -> Either [(Position, [String])] [a]
parse = Position
-> s Position i o a -> [i] -> Either [(Position, [String])] [a]
forall p (s :: * -> * -> * -> * -> *) i o a.
(Monoid p, PhaserType s) =>
p -> s p i o a -> [i] -> Either [(p, [String])] [a]
parse_ (Int -> Int -> Position
Position Int
1 Int
1)

-- | sepBy p sep parses zero or more occurrences of p, separated by sep. Returns
-- a list of values returned by p.
sepBy :: Monoid p => Phase p i o a -> Phase p i o s -> Phase p i o [a]
sepBy :: forall p i o a s.
Monoid p =>
Phase p i o a -> Phase p i o s -> Phase p i o [a]
sepBy Phase p i o a
p Phase p i o s
sep = Phase p i o a -> Phase p i o s -> Phase p i o [a]
forall p i o a s.
Monoid p =>
Phase p i o a -> Phase p i o s -> Phase p i o [a]
sepBy1 Phase p i o a
p Phase p i o s
sep Phase p i o [a] -> Phase p i o [a] -> Phase p i o [a]
forall a. Phase p i o a -> Phase p i o a -> Phase p i o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> Phase p i o [a]
forall a. a -> Phase p i o a
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | sepBy1 p sep parses one or more occurrences of p, separated by sep. Returns
-- a list of values returned by p.
sepBy1 :: Monoid p => Phase p i o a -> Phase p i o s -> Phase p i o [a]
sepBy1 :: forall p i o a s.
Monoid p =>
Phase p i o a -> Phase p i o s -> Phase p i o [a]
sepBy1 Phase p i o a
p Phase p i o s
sep = ((:) (a -> [a] -> [a]) -> Phase p i o a -> Phase p i o ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Phase p i o a
p Phase p i o ([a] -> [a]) -> Phase p i o [a] -> Phase p i o [a]
forall a b. Phase p i o (a -> b) -> Phase p i o a -> Phase p i o b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Phase p i o a -> Phase p i o [a]
forall a. Phase p i o a -> Phase p i o [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Phase p i o s
sep Phase p i o s -> Phase p i o a -> Phase p i o a
forall a b. Phase p i o a -> Phase p i o b -> Phase p i o b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Phase p i o a
p))

surround :: Phase p i o a -> Phase p i o b -> Phase p i o e -> Phase p i o a
surround :: forall p i o a b e.
Phase p i o a -> Phase p i o b -> Phase p i o e -> Phase p i o a
surround Phase p i o a
m Phase p i o b
o Phase p i o e
c = (\b
_ a
r e
_ -> a
r) (b -> a -> e -> a) -> Phase p i o b -> Phase p i o (a -> e -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Phase p i o b
o Phase p i o (a -> e -> a) -> Phase p i o a -> Phase p i o (e -> a)
forall a b. Phase p i o (a -> b) -> Phase p i o a -> Phase p i o b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Phase p i o a
m Phase p i o (e -> a) -> Phase p i o e -> Phase p i o a
forall a b. Phase p i o (a -> b) -> Phase p i o a -> Phase p i o b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Phase p i o e
c

-- | Parses the first zero or more values satisfying the predicate. Always
-- succeds, exactly once, having consumed all the characters Hence NOT the same
-- as (many (satisfy p))
munch :: Monoid p => (i -> Bool) -> Phase p i o [i]
munch :: forall p i o. Monoid p => (i -> Bool) -> Phase p i o [i]
munch i -> Bool
p = ([i] -> [i]) -> Phase p i o [i]
forall {p} {c} {o}. Monoid p => ([i] -> c) -> Phase p i o c
go [i] -> [i]
forall a. a -> a
id where
  go :: ([i] -> c) -> Phase p i o c
go [i] -> c
acc = (Phase p i o c -> Phase p i o c -> Phase p i o c)
-> Phase p i o c -> Phase p i o c -> Phase p i o c
forall a b c. (a -> b -> c) -> b -> a -> c
flip Phase p i o c -> Phase p i o c -> Phase p i o c
forall a. Phase p i o a -> Phase p i o a -> Phase p i o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (Phase p i o ()
forall p i o. Monoid p => Phase p i o ()
eof Phase p i o () -> Phase p i o c -> Phase p i o c
forall a b. Phase p i o a -> Phase p i o b -> Phase p i o b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> c -> Phase p i o c
forall a. a -> Phase p i o a
forall (m :: * -> *) a. Monad m => a -> m a
return ([i] -> c
acc [])) (Phase p i o c -> Phase p i o c) -> Phase p i o c -> Phase p i o c
forall a b. (a -> b) -> a -> b
$ do
    i
c <- Phase p i o i
forall p i o. Phase p i o i
get
    if i -> Bool
p i
c
      then ([i] -> c) -> Phase p i o c
go ([i] -> c
acc ([i] -> c) -> ([i] -> [i]) -> [i] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i
c i -> [i] -> [i]
forall a. a -> [a] -> [a]
:))
      else i -> Phase p i o ()
forall p i o. Monoid p => i -> Phase p i o ()
put1 i
c Phase p i o () -> Phase p i o c -> Phase p i o c
forall a b. Phase p i o a -> Phase p i o b -> Phase p i o b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> c -> Phase p i o c
forall a. a -> Phase p i o a
forall (m :: * -> *) a. Monad m => a -> m a
return ([i] -> c
acc [])

-- | Parses the first one or more values satisfying the predicate. Succeeds if
-- at least one value matches, having consumed all the characters Hence NOT the
-- same as (some (satisfy p))
munch1 :: Monoid p => (i -> Bool) -> Phase p i o [i]
munch1 :: forall p i o. Monoid p => (i -> Bool) -> Phase p i o [i]
munch1 i -> Bool
p = Phase p i o [i]
forall {o}. Phase p i o [i]
go1 where
  go1 :: Phase p i o [i]
go1 = do
    i
c <- Phase p i o i
forall p i o. Phase p i o i
get
    if i -> Bool
p i
c
      then ([i] -> [i]) -> Phase p i o [i]
forall {p} {b} {o}. Monoid p => ([i] -> b) -> Phase p i o b
go (i
c i -> [i] -> [i]
forall a. a -> [a] -> [a]
:) Phase p i o [i] -> Phase p i o [i] -> Phase p i o [i]
forall a. Phase p i o a -> Phase p i o a -> Phase p i o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Phase p i o ()
forall p i o. Monoid p => Phase p i o ()
eof Phase p i o () -> Phase p i o [i] -> Phase p i o [i]
forall a b. Phase p i o a -> Phase p i o b -> Phase p i o b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [i] -> Phase p i o [i]
forall a. a -> Phase p i o a
forall (m :: * -> *) a. Monad m => a -> m a
return [i
c])
      else Phase p i o [i]
forall a. Phase p i o a
forall (f :: * -> *) a. Alternative f => f a
empty
  go :: ([i] -> b) -> Phase p i o b
go [i] -> b
acc = do
    i
c <- Phase p i o i
forall p i o. Phase p i o i
get
    if i -> Bool
p i
c
      then ([i] -> b) -> Phase p i o b
go ([i] -> b
acc ([i] -> b) -> ([i] -> [i]) -> [i] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i
c i -> [i] -> [i]
forall a. a -> [a] -> [a]
:)) Phase p i o b -> Phase p i o b -> Phase p i o b
forall a. Phase p i o a -> Phase p i o a -> Phase p i o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Phase p i o ()
forall p i o. Monoid p => Phase p i o ()
eof Phase p i o () -> Phase p i o b -> Phase p i o b
forall a b. Phase p i o a -> Phase p i o b -> Phase p i o b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Phase p i o b
forall a. a -> Phase p i o a
forall (m :: * -> *) a. Monad m => a -> m a
return ([i] -> b
acc [i
c]))
      else i -> Phase p i o ()
forall p i o. Monoid p => i -> Phase p i o ()
put1 i
c Phase p i o () -> Phase p i o b -> Phase p i o b
forall a b. Phase p i o a -> Phase p i o b -> Phase p i o b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Phase p i o b
forall a. a -> Phase p i o a
forall (m :: * -> *) a. Monad m => a -> m a
return ([i] -> b
acc [])

-- | Run a parser on input from a file. Input is provided as bytes, if
-- characters are needed: a decoding phase such as
-- 'Codec.Phaser.UTF8.utf8_stream' or 'latin1' may be used.
parseFile :: (PhaserType s) => s Position Word8 o a -> FilePath ->
  IO (Either [(Position,[String])] [a])
parseFile :: forall (s :: * -> * -> * -> * -> *) o a.
PhaserType s =>
s Position Word8 o a
-> String -> IO (Either [(Position, [String])] [a])
parseFile = Position
-> s Position Word8 o a
-> String
-> IO (Either [(Position, [String])] [a])
forall p (s :: * -> * -> * -> * -> *) o a.
(Monoid p, PhaserType s) =>
p -> s p Word8 o a -> String -> IO (Either [(p, [String])] [a])
BP.parseFile_ (Int -> Int -> Position
Position Int
1 Int
1)

-- | Run a parser on input from a handle. Input is provided as bytes, if
-- characters are needed: a decoding phase such as
-- 'Codec.Phaser.UTF8.utf8_stream' may be used.
parseHandle :: (PhaserType s) => s Position Word8 o a -> Handle ->
  IO (Either [(Position,[String])] [a])
parseHandle :: forall (s :: * -> * -> * -> * -> *) o a.
PhaserType s =>
s Position Word8 o a
-> Handle -> IO (Either [(Position, [String])] [a])
parseHandle = Position
-> s Position Word8 o a
-> Handle
-> IO (Either [(Position, [String])] [a])
forall p (s :: * -> * -> * -> * -> *) o a.
(Monoid p, PhaserType s) =>
p -> s p Word8 o a -> Handle -> IO (Either [(p, [String])] [a])
BP.parseHandle_ (Int -> Int -> Position
Position Int
1 Int
1)

-- | Decode bytes to characters using the Latin1 (ISO8859-1) encoding
latin1 :: Monoid p => Phase p Word8 Char ()
latin1 :: forall p. Monoid p => Phase p Word8 Char ()
latin1 = Phase p Word8 Char ()
go where
  go :: Phase p Word8 Char ()
go = (Phase p Word8 Char ()
 -> Phase p Word8 Char () -> Phase p Word8 Char ())
-> Phase p Word8 Char ()
-> Phase p Word8 Char ()
-> Phase p Word8 Char ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Phase p Word8 Char ()
-> Phase p Word8 Char () -> Phase p Word8 Char ()
forall a.
Phase p Word8 Char a
-> Phase p Word8 Char a -> Phase p Word8 Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (() -> Phase p Word8 Char ()
forall a. a -> Phase p Word8 Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Phase p Word8 Char () -> Phase p Word8 Char ())
-> Phase p Word8 Char () -> Phase p Word8 Char ()
forall a b. (a -> b) -> a -> b
$ 
    (Word8 -> Char)
-> Phase p Word8 Char Word8 -> Phase p Word8 Char Char
forall a b.
(a -> b) -> Phase p Word8 Char a -> Phase p Word8 Char b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Phase p Word8 Char Word8
forall p i o. Phase p i o i
get Phase p Word8 Char Char
-> (Char -> Phase p Word8 Char ()) -> Phase p Word8 Char ()
forall a b.
Phase p Word8 Char a
-> (a -> Phase p Word8 Char b) -> Phase p Word8 Char b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> Phase p Word8 Char ()
forall o p i. o -> Phase p i o ()
yield Phase p Word8 Char ()
-> Phase p Word8 Char () -> Phase p Word8 Char ()
forall a b.
Phase p Word8 Char a
-> Phase p Word8 Char b -> Phase p Word8 Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Phase p Word8 Char ()
go

-- | Decode bytes to characters using the ASCII encoding, aborting if
-- any byte is outside the ASCII range.
ascii :: Monoid p => Phase p Word8 Char ()
ascii :: forall p. Monoid p => Phase p Word8 Char ()
ascii = Phase p Word8 Char ()
go where
  go :: Phase p Word8 Char ()
go = (Phase p Word8 Char ()
 -> Phase p Word8 Char () -> Phase p Word8 Char ())
-> Phase p Word8 Char ()
-> Phase p Word8 Char ()
-> Phase p Word8 Char ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Phase p Word8 Char ()
-> Phase p Word8 Char () -> Phase p Word8 Char ()
forall a.
Phase p Word8 Char a
-> Phase p Word8 Char a -> Phase p Word8 Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (() -> Phase p Word8 Char ()
forall a. a -> Phase p Word8 Char a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Phase p Word8 Char () -> Phase p Word8 Char ())
-> Phase p Word8 Char () -> Phase p Word8 Char ()
forall a b. (a -> b) -> a -> b
$ Phase p Word8 Char Word8
forall p i o. Phase p i o i
get Phase p Word8 Char Word8
-> (Word8 -> Phase p Word8 Char ()) -> Phase p Word8 Char ()
forall a b.
Phase p Word8 Char a
-> (a -> Phase p Word8 Char b) -> Phase p Word8 Char b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
c -> if Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x80 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0
    then Char -> Phase p Word8 Char ()
forall o p i. o -> Phase p i o ()
yield (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c) Phase p Word8 Char ()
-> Phase p Word8 Char () -> Phase p Word8 Char ()
forall a b.
Phase p Word8 Char a
-> Phase p Word8 Char b -> Phase p Word8 Char b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Phase p Word8 Char ()
go
    else String -> Phase p Word8 Char ()
forall a. String -> Phase p Word8 Char a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Byte out of ASCII range"

instance Standardized Char Int where
  regular :: forall p o. Monoid p => Phase p Char o Int
regular = Phase p Char o Int
forall a p o. (Num a, Monoid p) => Phase p Char o a
integer

instance Standardized Char Integer where
  regular :: forall p o. Monoid p => Phase p Char o Integer
regular = Phase p Char o Integer
forall a p o. (Num a, Monoid p) => Phase p Char o a
integer

instance Standardized Char Word where
  regular :: forall p o. Monoid p => Phase p Char o Word
regular = Phase p Char o Word
forall a p o. (Num a, Monoid p) => Phase p Char o a
positiveInteger

instance Standardized Char Word8 where
  regular :: forall p o. Monoid p => Phase p Char o Word8
regular = Phase p Char o Word8
forall a p o. (Num a, Monoid p) => Phase p Char o a
positiveInteger

instance Standardized Char Word16 where
  regular :: forall p o. Monoid p => Phase p Char o Word16
regular = Phase p Char o Word16
forall a p o. (Num a, Monoid p) => Phase p Char o a
positiveInteger

instance Standardized Char Word32 where
  regular :: forall p o. Monoid p => Phase p Char o Word32
regular = Phase p Char o Word32
forall a p o. (Num a, Monoid p) => Phase p Char o a
positiveInteger

instance Standardized Char Word64 where
  regular :: forall p o. Monoid p => Phase p Char o Word64
regular = Phase p Char o Word64
forall a p o. (Num a, Monoid p) => Phase p Char o a
positiveInteger

instance Standardized Char Int8 where
  regular :: forall p o. Monoid p => Phase p Char o Int8
regular = Phase p Char o Int8
forall a p o. (Num a, Monoid p) => Phase p Char o a
integer

instance Standardized Char Int16 where
  regular :: forall p o. Monoid p => Phase p Char o Int16
regular = Phase p Char o Int16
forall a p o. (Num a, Monoid p) => Phase p Char o a
integer

instance Standardized Char Int32 where
  regular :: forall p o. Monoid p => Phase p Char o Int32
regular = Phase p Char o Int32
forall a p o. (Num a, Monoid p) => Phase p Char o a
integer

instance Standardized Char Int64 where
  regular :: forall p o. Monoid p => Phase p Char o Int64
regular = Phase p Char o Int64
forall a p o. (Num a, Monoid p) => Phase p Char o a
integer

instance Standardized Char Float where
  regular :: forall p o. Monoid p => Phase p Char o Float
regular = Phase p Char o Float
forall a p o. (Fractional a, Monoid p) => Phase p Char o a
scientificNotation

instance Standardized Char Double where
  regular :: forall p o. Monoid p => Phase p Char o Double
regular = Phase p Char o Double
forall a p o. (Fractional a, Monoid p) => Phase p Char o a
scientificNotation

instance (Integral a,Standardized Char a) => Standardized Char (Ratio a) where
  regular :: forall p o. Monoid p => Phase p Char o (Ratio a)
regular = Phase p Char o (Ratio a)
forall a p o. (Fractional a, Monoid p) => Phase p Char o a
scientificNotation Phase p Char o (Ratio a)
-> Phase p Char o (Ratio a) -> Phase p Char o (Ratio a)
forall a. Phase p Char o a -> Phase p Char o a -> Phase p Char o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
(%) (a -> a -> Ratio a)
-> Phase p Char o a -> Phase p Char o (a -> Ratio a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Phase p Char o a
forall p o. Monoid p => Phase p Char o a
forall r a p o. (Standardized r a, Monoid p) => Phase p r o a
regular Phase p Char o (a -> Ratio a)
-> Phase p Char o a -> Phase p Char o (Ratio a)
forall a b.
Phase p Char o (a -> b) -> Phase p Char o a -> Phase p Char o b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (
    (Char -> Bool) -> Phase p Char o String
forall p i o. Monoid p => (i -> Bool) -> Phase p i o [i]
munch Char -> Bool
isSpace Phase p Char o String -> Phase p Char o Char -> Phase p Char o Char
forall a b.
Phase p Char o a -> Phase p Char o b -> Phase p Char o b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Phase p Char o Char
forall p o. Monoid p => Char -> Phase p Char o Char
char Char
'%' Phase p Char o Char
-> Phase p Char o String -> Phase p Char o String
forall a b.
Phase p Char o a -> Phase p Char o b -> Phase p Char o b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Phase p Char o String
forall p i o. Monoid p => (i -> Bool) -> Phase p i o [i]
munch Char -> Bool
isSpace Phase p Char o String -> Phase p Char o a -> Phase p Char o a
forall a b.
Phase p Char o a -> Phase p Char o b -> Phase p Char o b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Phase p Char o a
forall p o. Monoid p => Phase p Char o a
forall r a p o. (Standardized r a, Monoid p) => Phase p r o a
regular
   ))

instance Standardized Char Bool where
  regular :: forall p o. Monoid p => Phase p Char o Bool
regular = (Bool
False Bool -> Phase p Char o () -> Phase p Char o Bool
forall a b. a -> Phase p Char o b -> Phase p Char o a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Phase p Char o Char -> Phase p Char o ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Phase p Char o Char
forall p o. Monoid p => Char -> Phase p Char o Char
char Char
'0') Phase p Char o () -> Phase p Char o () -> Phase p Char o ()
forall a. Phase p Char o a -> Phase p Char o a -> Phase p Char o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Phase p Char o String -> Phase p Char o ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> Phase p Char o String
forall p o. Monoid p => String -> Phase p Char o String
iString String
"false"))) Phase p Char o Bool -> Phase p Char o Bool -> Phase p Char o Bool
forall a. Phase p Char o a -> Phase p Char o a -> Phase p Char o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    (Bool
True Bool -> Phase p Char o () -> Phase p Char o Bool
forall a b. a -> Phase p Char o b -> Phase p Char o a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Phase p Char o Char -> Phase p Char o ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Phase p Char o Char
forall p o. Monoid p => Char -> Phase p Char o Char
char Char
'1') Phase p Char o () -> Phase p Char o () -> Phase p Char o ()
forall a. Phase p Char o a -> Phase p Char o a -> Phase p Char o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Phase p Char o String -> Phase p Char o ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> Phase p Char o String
forall p o. Monoid p => String -> Phase p Char o String
iString String
"true")))

-- | Create a trie which maps a single string to an object. Analogous to
-- 'M.singleton'.
newTrie :: Ord c => [c] -> a -> Trie c a
newTrie :: forall c a. Ord c => [c] -> a -> Trie c a
newTrie [c]
l0 a
a = [c] -> Trie c a
forall {c}. [c] -> Trie c a
go [c]
l0 where
  go :: [c] -> Trie c a
go [] = [a] -> Map c (Trie c a) -> Trie c a
forall c a. [a] -> Map c (Trie c a) -> Trie c a
Trie [a
a] Map c (Trie c a)
forall k a. Map k a
M.empty
  go (c
c:[c]
r) = [a] -> Map c (Trie c a) -> Trie c a
forall c a. [a] -> Map c (Trie c a) -> Trie c a
Trie [] (Map c (Trie c a) -> Trie c a) -> Map c (Trie c a) -> Trie c a
forall a b. (a -> b) -> a -> b
$ c -> Trie c a -> Map c (Trie c a)
forall k a. k -> a -> Map k a
M.singleton c
c (Trie c a -> Map c (Trie c a)) -> Trie c a -> Map c (Trie c a)
forall a b. (a -> b) -> a -> b
$ [c] -> Trie c a
go [c]
r

-- | Create a trie from a list of strings and corresponding objects. Analogous
-- to 'M.fromList'
listToTrie :: Ord c => [([c],a)] -> Trie c a
listToTrie :: forall c a. Ord c => [([c], a)] -> Trie c a
listToTrie = [Trie c a] -> Trie c a
forall a. Monoid a => [a] -> a
mconcat ([Trie c a] -> Trie c a)
-> ([([c], a)] -> [Trie c a]) -> [([c], a)] -> Trie c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([c], a) -> Trie c a) -> [([c], a)] -> [Trie c a]
forall a b. (a -> b) -> [a] -> [b]
map (([c] -> a -> Trie c a) -> ([c], a) -> Trie c a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [c] -> a -> Trie c a
forall c a. Ord c => [c] -> a -> Trie c a
newTrie)

-- | Create a 'Phase' or 'Automaton' from a 'Trie'
fromTrie :: (Monoid p, PhaserType s, Ord c) => Trie c a -> s p c o a
fromTrie :: forall p (s :: * -> * -> * -> * -> *) c a o.
(Monoid p, PhaserType s, Ord c) =>
Trie c a -> s p c o a
fromTrie = Phase p c o a -> s p c o a
forall p i o a. Monoid p => Phase p i o a -> s p i o a
forall (s :: * -> * -> * -> * -> *) p i o a.
(PhaserType s, Monoid p) =>
Phase p i o a -> s p i o a
fromPhase (Phase p c o a -> s p c o a)
-> (Trie c a -> Phase p c o a) -> Trie c a -> s p c o a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trie c a -> Phase p c o a
forall {c} {p} {a} {o}.
(Ord c, Monoid p) =>
Trie c a -> Phase p c o a
go where
  go :: Trie c a -> Phase p c o a
go ~(Trie [a]
l Map c (Trie c a)
m) = let
    n :: Phase p c o a
n = Phase p c o c
forall p i o. Phase p i o i
get Phase p c o c -> (c -> Phase p c o a) -> Phase p c o a
forall a b. Phase p c o a -> (a -> Phase p c o b) -> Phase p c o b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \c
c -> case c -> Map c (Trie c a) -> Maybe (Trie c a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup c
c Map c (Trie c a)
m of
      Maybe (Trie c a)
Nothing -> Phase p c o a
forall a. Phase p c o a
forall (f :: * -> *) a. Alternative f => f a
empty
      Just Trie c a
r -> Trie c a -> Phase p c o a
go Trie c a
r
    in (Phase p c o a -> Phase p c o a -> Phase p c o a)
-> Phase p c o a -> [Phase p c o a] -> Phase p c o a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Phase p c o a -> Phase p c o a -> Phase p c o a
forall a. Phase p c o a -> Phase p c o a -> Phase p c o a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) Phase p c o a
n ((a -> Phase p c o a) -> [a] -> [Phase p c o a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Phase p c o a
forall a. a -> Phase p c o a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
l)