live-sequencer-0.0.6.1: src/Rule.hs

module Rule where

import qualified TermParser
import qualified Term
import InOut ( Input(input), Output(output), parsecReader )
import Term ( Term(Node), Identifier )
import SourceText ( ParserRange )

import Text.PrettyPrint.HughesPJ ( fsep, render, text )

import Control.Applicative ( (<$>) )


data Rule range = Rule
    { name :: Identifier range
    , parameters :: [ Term range ]
    , rhs :: Term range
    }

instance Functor Rule where
    fmap f r =
        Rule {
            name = f <$> name r,
            parameters = map (f <$>) $ parameters r,
            rhs = f <$> rhs r
        }

instance Show (Rule range) where show = render . output
instance (ParserRange range) =>
         Read (Rule range) where readsPrec = parsecReader

instance Output (Rule range) where
  output r =
    fsep [ output ( Node (name r) (parameters r) ), text "=",
           output ( rhs r ), text ";" ]

instance (ParserRange range) => Input (Rule range) where
  input = do
    t <- input
    (nm, ps) <-
        case t of
            Term.Node nm args ->
                if Term.isVariable nm
                  then return (nm, args)
                  else fail $ show nm ++ " is not a function identifier"
            _ -> fail $ "the term " ++ show t ++ " is not a valid left-hand side of a rule"
    TermParser.symbol "="
    r <- input
    TermParser.symbol ";"
    return $ Rule { name = nm, parameters = ps, rhs = r }