module Curry.Syntax.Extension
(
Extension (..), KnownExtension (..), classifyExtension, kielExtensions
, Tool (..), classifyTool
) where
import Data.Binary
import Data.Char (toUpper)
import Control.Monad
import Curry.Base.Ident (Ident (..))
import Curry.Base.Position
import Curry.Base.SpanInfo
data Extension
= KnownExtension SpanInfo KnownExtension
| UnknownExtension SpanInfo String
deriving (Extension -> Extension -> Bool
(Extension -> Extension -> Bool)
-> (Extension -> Extension -> Bool) -> Eq Extension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Extension -> Extension -> Bool
$c/= :: Extension -> Extension -> Bool
== :: Extension -> Extension -> Bool
$c== :: Extension -> Extension -> Bool
Eq, ReadPrec [Extension]
ReadPrec Extension
Int -> ReadS Extension
ReadS [Extension]
(Int -> ReadS Extension)
-> ReadS [Extension]
-> ReadPrec Extension
-> ReadPrec [Extension]
-> Read Extension
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Extension]
$creadListPrec :: ReadPrec [Extension]
readPrec :: ReadPrec Extension
$creadPrec :: ReadPrec Extension
readList :: ReadS [Extension]
$creadList :: ReadS [Extension]
readsPrec :: Int -> ReadS Extension
$creadsPrec :: Int -> ReadS Extension
Read, Int -> Extension -> ShowS
[Extension] -> ShowS
Extension -> String
(Int -> Extension -> ShowS)
-> (Extension -> String)
-> ([Extension] -> ShowS)
-> Show Extension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Extension] -> ShowS
$cshowList :: [Extension] -> ShowS
show :: Extension -> String
$cshow :: Extension -> String
showsPrec :: Int -> Extension -> ShowS
$cshowsPrec :: Int -> Extension -> ShowS
Show)
instance HasSpanInfo Extension where
getSpanInfo :: Extension -> SpanInfo
getSpanInfo (KnownExtension spi :: SpanInfo
spi _) = SpanInfo
spi
getSpanInfo (UnknownExtension spi :: SpanInfo
spi _) = SpanInfo
spi
setSpanInfo :: SpanInfo -> Extension -> Extension
setSpanInfo spi :: SpanInfo
spi (KnownExtension _ ke :: KnownExtension
ke) = SpanInfo -> KnownExtension -> Extension
KnownExtension SpanInfo
spi KnownExtension
ke
setSpanInfo spi :: SpanInfo
spi (UnknownExtension _ s :: String
s) = SpanInfo -> String -> Extension
UnknownExtension SpanInfo
spi String
s
instance HasPosition Extension where
getPosition :: Extension -> Position
getPosition = Extension -> Position
forall a. HasSpanInfo a => a -> Position
getStartPosition
setPosition :: Position -> Extension -> Extension
setPosition = Position -> Extension -> Extension
forall a. HasSpanInfo a => Position -> a -> a
setStartPosition
instance Binary Extension where
put :: Extension -> Put
put (KnownExtension p :: SpanInfo
p e :: KnownExtension
e) = Word8 -> Put
putWord8 0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SpanInfo -> Put
forall t. Binary t => t -> Put
put SpanInfo
p Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> KnownExtension -> Put
forall t. Binary t => t -> Put
put KnownExtension
e
put (UnknownExtension p :: SpanInfo
p e :: String
e) = Word8 -> Put
putWord8 1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SpanInfo -> Put
forall t. Binary t => t -> Put
put SpanInfo
p Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
e
get :: Get Extension
get = do
Word8
x <- Get Word8
getWord8
case Word8
x of
0 -> (SpanInfo -> KnownExtension -> Extension)
-> Get SpanInfo -> Get KnownExtension -> Get Extension
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SpanInfo -> KnownExtension -> Extension
KnownExtension Get SpanInfo
forall t. Binary t => Get t
get Get KnownExtension
forall t. Binary t => Get t
get
1 -> (SpanInfo -> String -> Extension)
-> Get SpanInfo -> Get String -> Get Extension
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SpanInfo -> String -> Extension
UnknownExtension Get SpanInfo
forall t. Binary t => Get t
get Get String
forall t. Binary t => Get t
get
_ -> String -> Get Extension
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid encoding for Extension"
instance Binary KnownExtension where
put :: KnownExtension -> Put
put AnonFreeVars = Word8 -> Put
putWord8 0
put CPP = Word8 -> Put
putWord8 1
put FunctionalPatterns = Word8 -> Put
putWord8 2
put NegativeLiterals = Word8 -> Put
putWord8 3
put NoImplicitPrelude = Word8 -> Put
putWord8 4
get :: Get KnownExtension
get = do
Word8
x <- Get Word8
getWord8
case Word8
x of
0 -> KnownExtension -> Get KnownExtension
forall (m :: * -> *) a. Monad m => a -> m a
return KnownExtension
AnonFreeVars
1 -> KnownExtension -> Get KnownExtension
forall (m :: * -> *) a. Monad m => a -> m a
return KnownExtension
CPP
2 -> KnownExtension -> Get KnownExtension
forall (m :: * -> *) a. Monad m => a -> m a
return KnownExtension
FunctionalPatterns
3 -> KnownExtension -> Get KnownExtension
forall (m :: * -> *) a. Monad m => a -> m a
return KnownExtension
NegativeLiterals
4 -> KnownExtension -> Get KnownExtension
forall (m :: * -> *) a. Monad m => a -> m a
return KnownExtension
NoImplicitPrelude
_ -> String -> Get KnownExtension
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid encoding for KnownExtension"
data KnownExtension
= AnonFreeVars
| CPP
| FunctionalPatterns
| NegativeLiterals
| NoImplicitPrelude
deriving (KnownExtension -> KnownExtension -> Bool
(KnownExtension -> KnownExtension -> Bool)
-> (KnownExtension -> KnownExtension -> Bool) -> Eq KnownExtension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KnownExtension -> KnownExtension -> Bool
$c/= :: KnownExtension -> KnownExtension -> Bool
== :: KnownExtension -> KnownExtension -> Bool
$c== :: KnownExtension -> KnownExtension -> Bool
Eq, ReadPrec [KnownExtension]
ReadPrec KnownExtension
Int -> ReadS KnownExtension
ReadS [KnownExtension]
(Int -> ReadS KnownExtension)
-> ReadS [KnownExtension]
-> ReadPrec KnownExtension
-> ReadPrec [KnownExtension]
-> Read KnownExtension
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [KnownExtension]
$creadListPrec :: ReadPrec [KnownExtension]
readPrec :: ReadPrec KnownExtension
$creadPrec :: ReadPrec KnownExtension
readList :: ReadS [KnownExtension]
$creadList :: ReadS [KnownExtension]
readsPrec :: Int -> ReadS KnownExtension
$creadsPrec :: Int -> ReadS KnownExtension
Read, Int -> KnownExtension -> ShowS
[KnownExtension] -> ShowS
KnownExtension -> String
(Int -> KnownExtension -> ShowS)
-> (KnownExtension -> String)
-> ([KnownExtension] -> ShowS)
-> Show KnownExtension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KnownExtension] -> ShowS
$cshowList :: [KnownExtension] -> ShowS
show :: KnownExtension -> String
$cshow :: KnownExtension -> String
showsPrec :: Int -> KnownExtension -> ShowS
$cshowsPrec :: Int -> KnownExtension -> ShowS
Show, Int -> KnownExtension
KnownExtension -> Int
KnownExtension -> [KnownExtension]
KnownExtension -> KnownExtension
KnownExtension -> KnownExtension -> [KnownExtension]
KnownExtension
-> KnownExtension -> KnownExtension -> [KnownExtension]
(KnownExtension -> KnownExtension)
-> (KnownExtension -> KnownExtension)
-> (Int -> KnownExtension)
-> (KnownExtension -> Int)
-> (KnownExtension -> [KnownExtension])
-> (KnownExtension -> KnownExtension -> [KnownExtension])
-> (KnownExtension -> KnownExtension -> [KnownExtension])
-> (KnownExtension
-> KnownExtension -> KnownExtension -> [KnownExtension])
-> Enum KnownExtension
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: KnownExtension
-> KnownExtension -> KnownExtension -> [KnownExtension]
$cenumFromThenTo :: KnownExtension
-> KnownExtension -> KnownExtension -> [KnownExtension]
enumFromTo :: KnownExtension -> KnownExtension -> [KnownExtension]
$cenumFromTo :: KnownExtension -> KnownExtension -> [KnownExtension]
enumFromThen :: KnownExtension -> KnownExtension -> [KnownExtension]
$cenumFromThen :: KnownExtension -> KnownExtension -> [KnownExtension]
enumFrom :: KnownExtension -> [KnownExtension]
$cenumFrom :: KnownExtension -> [KnownExtension]
fromEnum :: KnownExtension -> Int
$cfromEnum :: KnownExtension -> Int
toEnum :: Int -> KnownExtension
$ctoEnum :: Int -> KnownExtension
pred :: KnownExtension -> KnownExtension
$cpred :: KnownExtension -> KnownExtension
succ :: KnownExtension -> KnownExtension
$csucc :: KnownExtension -> KnownExtension
Enum, KnownExtension
KnownExtension -> KnownExtension -> Bounded KnownExtension
forall a. a -> a -> Bounded a
maxBound :: KnownExtension
$cmaxBound :: KnownExtension
minBound :: KnownExtension
$cminBound :: KnownExtension
Bounded)
classifyExtension :: Ident -> Extension
classifyExtension :: Ident -> Extension
classifyExtension i :: Ident
i = case ReadS KnownExtension
forall a. Read a => ReadS a
reads String
extName of
[(e :: KnownExtension
e, "")] -> SpanInfo -> KnownExtension -> Extension
KnownExtension (Ident -> SpanInfo
forall a. HasSpanInfo a => a -> SpanInfo
getSpanInfo Ident
i) KnownExtension
e
_ -> SpanInfo -> String -> Extension
UnknownExtension (Ident -> SpanInfo
forall a. HasSpanInfo a => a -> SpanInfo
getSpanInfo Ident
i) String
extName
where extName :: String
extName = Ident -> String
idName Ident
i
kielExtensions :: [KnownExtension]
kielExtensions :: [KnownExtension]
kielExtensions = [KnownExtension
AnonFreeVars, KnownExtension
FunctionalPatterns]
data Tool = KICS2 | PAKCS | CYMAKE | FRONTEND | UnknownTool String
deriving (Tool -> Tool -> Bool
(Tool -> Tool -> Bool) -> (Tool -> Tool -> Bool) -> Eq Tool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tool -> Tool -> Bool
$c/= :: Tool -> Tool -> Bool
== :: Tool -> Tool -> Bool
$c== :: Tool -> Tool -> Bool
Eq, ReadPrec [Tool]
ReadPrec Tool
Int -> ReadS Tool
ReadS [Tool]
(Int -> ReadS Tool)
-> ReadS [Tool] -> ReadPrec Tool -> ReadPrec [Tool] -> Read Tool
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Tool]
$creadListPrec :: ReadPrec [Tool]
readPrec :: ReadPrec Tool
$creadPrec :: ReadPrec Tool
readList :: ReadS [Tool]
$creadList :: ReadS [Tool]
readsPrec :: Int -> ReadS Tool
$creadsPrec :: Int -> ReadS Tool
Read, Int -> Tool -> ShowS
[Tool] -> ShowS
Tool -> String
(Int -> Tool -> ShowS)
-> (Tool -> String) -> ([Tool] -> ShowS) -> Show Tool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tool] -> ShowS
$cshowList :: [Tool] -> ShowS
show :: Tool -> String
$cshow :: Tool -> String
showsPrec :: Int -> Tool -> ShowS
$cshowsPrec :: Int -> Tool -> ShowS
Show)
instance Binary Tool where
put :: Tool -> Put
put KICS2 = Word8 -> Put
putWord8 0
put PAKCS = Word8 -> Put
putWord8 1
put CYMAKE = Word8 -> Put
putWord8 2
put FRONTEND = Word8 -> Put
putWord8 3
put (UnknownTool s :: String
s) = Word8 -> Put
putWord8 4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
s
get :: Get Tool
get = do
Word8
x <- Get Word8
getWord8
case Word8
x of
0 -> Tool -> Get Tool
forall (m :: * -> *) a. Monad m => a -> m a
return Tool
KICS2
1 -> Tool -> Get Tool
forall (m :: * -> *) a. Monad m => a -> m a
return Tool
PAKCS
2 -> Tool -> Get Tool
forall (m :: * -> *) a. Monad m => a -> m a
return Tool
CYMAKE
3 -> Tool -> Get Tool
forall (m :: * -> *) a. Monad m => a -> m a
return Tool
FRONTEND
4 -> (String -> Tool) -> Get String -> Get Tool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Tool
UnknownTool Get String
forall t. Binary t => Get t
get
_ -> String -> Get Tool
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Invalid encoding for Tool"
classifyTool :: String -> Tool
classifyTool :: String -> Tool
classifyTool str :: String
str = case ReadS Tool
forall a. Read a => ReadS a
reads ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
str) of
[(t :: Tool
t, "")] -> Tool
t
_ -> String -> Tool
UnknownTool String
str