module Data.Syntax.Char (
SyntaxChar(..),
SyntaxText,
signed,
spaces,
spaces_,
spaces1,
endOfLine,
digitDec,
digitOct,
digitHex
) where
import Control.Lens.SemiIso
import Data.Bits
import Data.Char
import Data.MonoTraversable
import Data.Scientific (Scientific)
import Data.SemiIsoFunctor
import Data.Syntax
import Data.Syntax.Combinator
import Data.Text (Text)
class (Syntax syn seq, Element seq ~ Char) => SyntaxChar syn seq where
decimal :: Integral a => syn a
hexadecimal :: (Integral a, Bits a) => syn a
realFloat :: RealFloat a => syn a
scientific :: syn Scientific
type SyntaxText syn = SyntaxChar syn Text
signed :: (Real a, SyntaxChar syn seq) => syn a -> syn a
signed n = _Negative /$/ char '-' */ n
/|/ opt_ (char '+') */ n
spaces :: SyntaxChar syn seq => syn ()
spaces = opt spaces1
spaces_ :: SyntaxChar syn seq => syn ()
spaces_ = opt_ spaces1
spaces1 :: SyntaxChar syn seq => syn ()
spaces1 = constant (opoint ' ') /$/ takeWhile1 isSpace
endOfLine :: SyntaxChar syn seq => syn ()
endOfLine = char '\n'
digitDec :: SyntaxChar syn seq => syn Int
digitDec = semiIso toChar toInt /$/ anyChar
where toInt c | isDigit c = Right (digitToInt c)
| otherwise = Left ("Expected a decimal digit, got " ++ [c])
toChar i | i >= 0 && i <= 9 = Right (intToDigit i)
| otherwise = Left ("Expected a decimal digit, got number " ++ show i)
digitOct :: SyntaxChar syn seq => syn Int
digitOct = semiIso toChar toInt /$/ anyChar
where toInt c | isOctDigit c = Right (digitToInt c)
| otherwise = Left ("Expected an octal digit, got " ++ [c])
toChar i | i >= 0 && i <= 7 = Right (intToDigit i)
| otherwise = Left ("Expected an octal digit, got number " ++ show i)
digitHex :: SyntaxChar syn seq => syn Int
digitHex = semiIso toChar toInt /$/ anyChar
where toInt c | isHexDigit c = Right (digitToInt c)
| otherwise = Left ("Expected a hex digit, got " ++ [c])
toChar i | i >= 0 && i <= 15 = Right (intToDigit i)
| otherwise = Left ("Expected a hex digit, got number " ++ show i)