diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,11 @@ +1.2 => 1.3 +============= +This package has been extended and now includes: + +* An Input module, allowing files to be parsed. + +* An example of the usage of this module. + 1.1.0.1 => 1.2 ============= This package version is now compatible with the translation package CarneadesIntoDung. diff --git a/CarneadesDSL.cabal b/CarneadesDSL.cabal --- a/CarneadesDSL.cabal +++ b/CarneadesDSL.cabal @@ -1,6 +1,6 @@ name: CarneadesDSL category: Argumentation, Embedded, AI -version: 1.2 +version: 1.3 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE @@ -8,10 +8,10 @@ maintainer: Bas van Gijzel stability: experimental homepage: http://www.cs.nott.ac.uk/~bmv/CarneadesDSL/ -copyright: Copyright (C) 2013 Bas van Gijzel +copyright: Copyright (C) 2014 Bas van Gijzel synopsis: An implementation and DSL for the Carneades argumentation model. description: An implementation and domain specific language for the Carneades - argumentation model. See Haskell Gets Argumentative in the + argumentation model. See "Haskell Gets Argumentative" in the Proceedings of Symposium on Trends in Functional Programming (TFP 2012) by Bas van Gijzel and Henrik Nilsson or the package's homepage. Thanks to Stefan Sabev for providing initial @@ -20,18 +20,20 @@ Extra-Source-Files: CHANGELOG + examplecaes.txt Library build-depends: base >= 4 && < 5, containers >= 0.3 && < 0.6, - fgl >= 5.4.2.4 && < 5.5 - + fgl >= 5.4.2.4, + parsec >= 3 exposed-modules: Language.Carneades.CarneadesDSL Language.Carneades.ExampleCAES Language.Carneades.Cyclic + Language.Carneades.Input source-repository head diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c)2012, Bas van Gijzel, Henrik Nilsson +Copyright (c)2014, Bas van Gijzel, Henrik Nilsson All rights reserved. diff --git a/Language/Carneades/CarneadesDSL.lhs b/Language/Carneades/CarneadesDSL.lhs --- a/Language/Carneades/CarneadesDSL.lhs +++ b/Language/Carneades/CarneadesDSL.lhs @@ -169,7 +169,7 @@ data PSName = Scintilla | Preponderance | ClearAndConvincing | BeyondReasonableDoubt | DialecticalValidity - deriving Eq + deriving (Show, Eq) \end{code} \begin{spec} diff --git a/Language/Carneades/ExampleCAES.lhs b/Language/Carneades/ExampleCAES.lhs --- a/Language/Carneades/ExampleCAES.lhs +++ b/Language/Carneades/ExampleCAES.lhs @@ -5,6 +5,9 @@ import Prelude hiding (negate) import Language.Carneades.CarneadesDSL +import Language.Carneades.Input +import System.Exit +import Control.Monad (when) \end{code} @@ -141,6 +144,38 @@ testNotMurder = acceptable (mkProp "-murder") caes \end{code} +Assuming a file examplecaes.txt with the following input: + +argument arg1 ["kill", "intent"] [ ] "murder" +argument arg2 ["witness" ] ["unreliable"] "intent" +argument arg3 ["witness2"] ["unreliable2"] "-intent" + +weight arg1 0.8 +weight arg2 0.3 +weight arg3 0.8 + +assumptions ["kill", "witness", "witness2", "unreliable2"] + +-- Haskell style commments are allowed. + +{- also valid for standards: + standard "intent" BeyondReasonableDoubt -} + +standard "kill" scintilla +standard "intent" beyond_reasonable_doubt + + +\begin{code} +parse :: IO () +parse = do + input <- readFile "examplecaes.txt" + (CAES (argSet, (assumps, weight), standard)) <- case parseCAES input of + Left err -> putStrLn "Parsing error: " >> print err >> exitWith (ExitFailure 1) + Right caes -> return caes + print $ getAllArgs argSet + print assumps + print $ standard (mkProp "intent") +\end{code} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%End example code%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/Language/Carneades/Input.hs b/Language/Carneades/Input.hs new file mode 100644 --- /dev/null +++ b/Language/Carneades/Input.hs @@ -0,0 +1,224 @@ +-- | This is the input module accompanying the implementation of Carneades. +-- It defines a simple parser for a Carneades Argument Evaluation Structure +-- (CAES). +-- +-- Files are assumed to have the following order of content: +-- one argument or attack on each line, ending +-- in a dot. (Our parser is slightly more relaxed than this and +-- doesn't care about whitespace.) +-- +-- @att(a1,a2).@ or @arg(a1).@ +-- +-- Argument names are assumed to consist only of letters and numbers. +-- Arguments used in attacks should be declared separately as well. +-- +-- For a complete example see +-- (also included as an additional source file) or see the accompanying +-- ExampleCAES module. +module Language.Carneades.Input + ( + -- * Parsing functions + parseCAES, pCAES + ) + where +import Language.Carneades.CarneadesDSL +import Text.Parsec +import Text.Parsec.String (Parser) +import Text.Parsec.Char (char, string) +import qualified Text.Parsec.Token as P +import Text.Parsec.Language(haskellStyle) +import Text.Parsec.Error(errorMessages, messageString) +import Data.Either (partitionEithers) +import Debug.Trace +import Data.Maybe(fromMaybe) + +-- This allows the parsing of a CAES to have comments, +-- arguments consisting of a letter followed by alphanumerical characters, etc. +lexer :: P.TokenParser () +lexer = P.makeTokenParser + (haskellStyle + { P.reservedNames = ["Scintilla", "Preponderance", "ClearAndConvincing", + "BeyondReasonableDoubt", "DialecticalValidity", + "scintilla", "preponderance", "clear_and_convincing", + "beyond_reasonable_doubt", "dialectical_validity"] + } + ) + +whiteSpace :: Parser () +whiteSpace = P.whiteSpace lexer + +identifier :: Parser String +identifier = P.identifier lexer + +stringLiteral :: Parser String +stringLiteral = P.stringLiteral lexer + +symbol :: String -> Parser String +symbol = P.symbol lexer + +float :: Parser Double +float = P.float lexer + +-- A named Carneades argument. +data Argument' = Arg' String ([PropLiteral], [PropLiteral], PropLiteral) + deriving (Eq, Show) + +-- A weight to a name of a Carneades argument. +type Weight' = (String, Double) + +-- A proof standard to a name of a Carneades argument. +type Standard' = (String, PSName) + +-- |An argument name consists of a letter followed by one or more letters and digits, +-- underscore or \'. Alternatively, a string literal. +argName :: Parser String +argName = try identifier <|> stringLiteral + +-- |Parses a proposition by parsing an identifier and using 'mkProp' from the +-- CarneadesDSL package. +pProposition :: Parser PropLiteral +pProposition = do + p <- argName + whiteSpace + return (mkProp p) + +-- |Parses a list of propositions. Propositions are separated by commas. +-- Optional whitespace is allowed in the list. +pPropositions :: Parser [PropLiteral] +pPropositions = do + char '[' >> whiteSpace + ps <- pProposition `sepBy` (symbol "," >> whiteSpace) + char ']' >> whiteSpace + return ps + +-- |Parses a complete argument consists of @arg@ or @argument@ followed by an + -- @argName@, two lists of propositions, and a conclusion. +pArgument :: Parser Argument' +pArgument = do + try (string "argument") <|> string "arg" + whiteSpace + name <- argName + prems <- pPropositions + excs <- pPropositions + c <- pProposition + return (Arg' name (prems, excs, c)) + +-- |Parses one declaration of a weight. A weight is declared by the string +-- @weight@ followed by the name of a previously declared argument, +-- and a 'Double' assigned to that argument. +pWeight :: Parser Weight' +pWeight = do + string "weight" >> whiteSpace + name <- argName + weight <- float + return (name, weight) + +-- |Parses a list of assumptions. A list of assumptions is just the keyword +-- @assumptions@ followed by a list of propositions. +pAssumptions :: Parser Assumptions +pAssumptions = do + string "assumptions" >> whiteSpace + pPropositions + +-- |Parses the name of a proof standard allowing both the names as given in +-- the original paper and the constructors of PSName. +pPSName :: Parser PSName +pPSName = try ((try (string "Scintilla") <|> + string "scintilla") + >> return Scintilla) + <|> try ((try (string "Preponderance") <|> + string "preponderance") + >> return Preponderance) + <|> try ((try (string "ClearAndConvincing") <|> + string "clear_and_convincing") + >> return ClearAndConvincing) + <|> try ((try (string "BeyondReasonableDoubt") <|> + string "beyond_reasonable_doubt") + >> return BeyondReasonableDoubt) + <|> try ((try (string "DialecticalValidity") <|> + string "dialectical_validity") + >> return DialecticalValidity) + +-- |Parses one declaration of a proof standard. A proof standard is declared +-- by the string @standard@ followed by a proposition and the name of a proof +-- standard. +pStandard :: Parser Standard' +pStandard = do + string "standard" + whiteSpace + name <- argName + psName <- pPSName + whiteSpace + return (name, psName) + +-- |Converts a named argument to the definition used in the implementation +-- (and the paper). +argToArg :: Argument' -> Argument +argToArg (Arg' _ a) = Arg a + +-- |Looks up a normal argument in a list of named argument and returns its name. +lookupArg :: Argument -> [Argument'] -> Maybe String +lookupArg a [] = Nothing +lookupArg a (Arg' name a' : args) + | a == Arg a' = Just name + | otherwise = lookupArg a args + +-- |Converts a list of named 'Argument\''s and named 'Weight\''s to a weight +-- function. Arguments not assigned a weight will raise an error. +weightToWeight :: [Argument'] -> [Weight'] -> ArgWeight +weightToWeight args ws arg = + fromMaybe (error $ "no weight assigned to" ++ show arg) + (lookupArg arg args >>= \name -> lookup name ws) + +-- |Converts a list of named 'Standard\''s to a standard function. +-- Propositions not assigned a weight will raise an error. +standardToStandard :: [Standard'] -> PropStandard +standardToStandard [] p = error $ "no standard assigned to" ++ show p +standardToStandard ((name, st) : sts) p + | mkProp name == p = st + | otherwise = standardToStandard sts p + +-- |Parses the definition of a complete Carneades Argument Evaluation Structure +-- (CAES). +-- +-- A CAES is parsed in multiple stages: +-- +-- First parsing zero or more arguments: +-- where a complete argument consists of @arg@ or @argument@ followed by an +-- @argName@ (a letter followed by one or more letters and digits, +-- underscore or \'; alternatively, a string literal), two lists of propositions, +-- and a conclusion. +-- +-- Then, zero or more weights, +-- where a weight is declared by the string +-- @weight@ followed by the name of a previously declared argument, +-- and a 'Double' assigned to that argument. +-- +-- Then, a list of assumptions, +-- where a list of assumptions is just the keyword +-- @assumptions@ followed by a list of propositions. +-- +-- Then a list of proof standard declarations, +-- where a proof standard is declared +-- by the string @standard@ followed by a proposition and the name of a proof +-- standard. +-- +-- This is followed by an end of file token. +pCAES :: Parser CAES +pCAES = do + whiteSpace + args <- many pArgument + weights <- many pWeight + assumps <- pAssumptions + standards <- many pStandard + eof + let weight = weightToWeight args weights + let audience = (assumps, weight) + let standard = standardToStandard standards + let argSet = mkArgSet (map argToArg args) + return (CAES (argSet, audience, standard)) + +-- |Parses a 'String' containing a CAES. +-- If parsing fails, it propagates the parse error. +parseCAES :: String -> Either ParseError CAES +parseCAES = parse pCAES "" diff --git a/examplecaes.txt b/examplecaes.txt new file mode 100644 --- /dev/null +++ b/examplecaes.txt @@ -0,0 +1,19 @@ +argument arg1 ["kill", "intent"] [ ] "murder" +argument arg2 ["witness" ] ["unreliable"] "intent" +argument arg3 ["witness2"] ["unreliable2"] "-intent" + +weight arg1 0.8 +weight arg2 0.3 +weight arg3 0.8 + +assumptions ["kill", "witness", "witness2", "unreliable2"] + +-- Haskell style commments are allowed. + +{- also valid for standards: + standard "intent" BeyondReasonableDoubt -} + +standard "kill" scintilla +standard "intent" beyond_reasonable_doubt + +