1 implementation module GenIRC
3 from IRC import :: IRCCommand, :: CSepList(CSepList)
4 from Data.Func import $
5 from StdFunc import o, const
7 from Text.Parsers.Simple.Core import :: Error
16 from Text import class Text(join,split,indexOf,concat), instance Text String
18 pOne [] = (Left "Expected an argument", [])
19 pOne [a:as] = (Right a, as)
21 generic gIRCParse a :: [String] -> (Either Error a, [String])
22 gIRCParse{|UNIT|} a = (Right UNIT, a)
23 gIRCParse{|String|} as = pOne as
24 gIRCParse{|Int|} as = appFst (fmap toInt) $ pOne as
25 gIRCParse{|EITHER|} lp rp as = case lp as of
26 (Right a, rest) = (Right $ LEFT a, rest)
27 (Left e1, _) = case rp as of
28 (Right a, rest) = (Right $ RIGHT a, rest)
29 (Left e2, _) = (Left $ e1 +++ " and " +++ e2, [])
30 gIRCParse{|OBJECT|} p as = appFst (fmap OBJECT) $ p as
31 gIRCParse{|CONS of d|} p []
32 = (Left $ concat ["Expected a cmd constructor: ", d.gcd_name], [])
33 gIRCParse{|CONS of d|} p [a:as]
34 | a <> d.gcd_name = (Left $ concat [
35 "Wrong constructor. expected: ", d.gcd_name, ", got: ", a], [])
37 (Right a, rest) = (Right $ CONS a, rest)
38 (Left e, _) = (Left e, [])
39 gIRCParse{|PAIR|} pl pr as = case pl as of
40 (Right a1, rest) = case pr rest of
41 (Right a2, rest) = (Right $ PAIR a1 a2, rest)
42 (Left e, _) = (Left e, [])
43 (Left e, _) = (Left e, [])
44 gIRCParse{|[]|} pl as = case pl as of
45 (Right e, rest) = case gIRCParse{|*->*|} pl rest of
46 (Right es, rest) = (Right [e:es], rest)
47 (Left e, _) = (Left e, [])
48 (Left e, _) = (Right [], as)
49 gIRCParse{|Maybe|} pm as
50 = appFst (either (const $ Right Nothing) $ Right o Just) $ pm as
51 gIRCParse{|CSepList|} as = appFst (fmap $ CSepList o split ",") $ pOne as
53 derive gIRCParse (,), IRCCommand
54 derive gIRCPrint (,), IRCCommand
56 generic gIRCPrint a :: a -> [String]
57 gIRCPrint{|UNIT|} _ = []
58 gIRCPrint{|String|} s = if (indexOf " " s == -1) [s] [":"+++s]
59 gIRCPrint{|Int|} i = [toString i]
60 gIRCPrint{|EITHER|} lp rp (LEFT i) = lp i
61 gIRCPrint{|EITHER|} lp rp (RIGHT i) = rp i
62 gIRCPrint{|OBJECT|} lp (OBJECT p) = lp p
63 gIRCPrint{|PAIR|} lp rp (PAIR l r) = lp l ++ rp r
64 gIRCPrint{|CONS of d|} pc (CONS c) = [d.gcd_name:pc c]
65 gIRCPrint{|[]|} pl x = flatten $ map pl x
66 gIRCPrint{|Maybe|} pl m = gIRCPrint{|*->*|} pl $ maybeToList m
67 gIRCPrint{|CSepList|} (CSepList as) = [join "," as]