module Data.ProtoLens.Compiler.Combinators where
import Data.Char (isAlphaNum, isUpper)
import Data.String (IsString(..))
import Language.Haskell.Exts.SrcLoc (noLoc)
import Language.Haskell.Exts.Syntax as Syntax
class App a where
(@@) :: a -> a -> a
infixl 2 @@
instance App Type where
(@@) = TyApp
instance App Exp where
(@@) = App
instance IsString Name where
fromString s
| all isIdentChar s = Ident s
| otherwise = Symbol s
isIdentChar :: Char -> Bool
isIdentChar c = isAlphaNum c || c `elem` "_'"
instance IsString ModuleName where
fromString = ModuleName
instance IsString QName where
fromString f
| isIdentChar (last f), '.' `elem` f
, (f', '.':f'') <- span (/='.') (reverse f)
= Qual (fromString $ reverse f'') (fromString $ reverse f')
| otherwise = UnQual $ fromString f
instance IsString Type where
fromString fs@(f:_)
| isUpper f = TyCon $ fromString fs
fromString fs = TyVar $ fromString fs
instance IsString Exp where
fromString fs@(f:_)
| isUpper f = Con $ fromString fs
fromString fs = Var $ fromString fs
instance IsString Pat where
fromString = PVar . fromString
instance IsString TyVarBind where
fromString = UnkindedVar . fromString
litInt :: Integer -> Exp
litInt n
| n >= 0 = Lit $ Int n
| otherwise = NegApp $ Lit $ Int $ negate n
litFrac :: Rational -> Exp
litFrac x
| x >= 0 = Lit $ Frac x
| otherwise = NegApp $ Lit $ Frac $ negate x
pLitInt :: Integer -> Pat
pLitInt n
| n >= 0 = PLit Signless $ Int n
| otherwise = PLit Negative $ Int $ negate n
match :: Name -> [Pat] -> Exp -> Match
match n ps e = Match noLoc n ps Nothing (UnGuardedRhs e) Nothing