GenIRC.icl

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