GenIRC.icl

   1 implementation module GenIRC
   2
   3 from IRC import :: IRCCommand, :: CSepList(CSepList)
   4 from Data.Func import $
   5 from StdFunc import o, const
   6
   7 from Text.Parsers.Simple.Core import :: Error
   8
   9 import StdList
  10 import StdString
  11 import StdGeneric
  12 import Data.Either
  13 import Data.Maybe
  14 import Data.Tuple
  15 import Data.Functor
  16 from Text import class Text(join,split,indexOf,concat), instance Text String
  17
  18 pOne [] = (Left "Expected an argument", [])
  19 pOne [a:as] = (Right a, as)
  20
  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 $ 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], [])
  36         = case p as of
  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
  52
  53 derive gIRCParse (,), IRCCommand
  54 derive gIRCPrint (,), IRCCommand
  55
  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]