Skip to content

Commit 9b4fdac

Browse files
herrmannoherrmanno
committed
Standardize task format
Close #9
1 parent f25084e commit 9b4fdac

21 files changed

+417
-104
lines changed

‎app/App.hs

+55-44
Original file line numberDiff line numberDiff line change
@@ -1,52 +1,63 @@
1-
module App ( app, help ) where
1+
module App ( app, taskHelp, help ) where
22

3-
import Tasks.Sets as Set ( runTask )
4-
import Tasks.Relations as Relation ( runTask )
5-
import Tasks.Structures as Structures ( runTask )
6-
import Tasks.Graphs as Graphs ( runTask )
7-
import Tasks.Circle as Circle ( runTask )
8-
import Tasks.Hamilton as Hamilton ( runTask )
9-
import Tasks.Bipartit as Bipartit ( runTask )
10-
import Tasks.Isomorphism as Isomorphism ( runTask )
11-
import Tasks.StatementModel as StatementModel ( runTask )
12-
import Tasks.StatementEquivalent as StatementEquivalent ( runTask )
13-
import Tasks.StatementTransform as StatementTransform ( runTask )
14-
import Tasks.StatementCNF as StatementCNF ( runTask )
15-
import Tasks.StatementDNF as StatementDNF ( runTask )
3+
import Task (Task(..), describeTask, shortDescribeTask)
4+
import qualified Tasks.Sets as Set ( task )
5+
import qualified Tasks.Relations as Relation ( task )
6+
import qualified Tasks.Structures as Structures ( task )
7+
import qualified Tasks.Graphs as Graphs ( task )
8+
import qualified Tasks.Circle as Circle ( task )
9+
import qualified Tasks.Hamilton as Hamilton ( task )
10+
import qualified Tasks.Bipartit as Bipartit ( task )
11+
import qualified Tasks.Isomorphism as Isomorphism ( task )
12+
import qualified Tasks.StatementModel as StatementModel ( task )
13+
import qualified Tasks.StatementEquivalent as StatementEquivalent ( task )
14+
import qualified Tasks.StatementTransform as StatementTransform ( task )
15+
import qualified Tasks.StatementCNF as StatementCNF ( task )
16+
import qualified Tasks.StatementDNF as StatementDNF ( task )
17+
import Data.Foldable (find)
18+
import Data.Char (toLower)
19+
import Data.Function (on)
20+
21+
22+
tasks :: [Task]
23+
tasks =
24+
[ StatementModel.task
25+
, StatementEquivalent.task
26+
, StatementTransform.task
27+
, StatementCNF.task
28+
, StatementDNF.task
29+
,Set.task
30+
, Relation.task
31+
, Graphs.task
32+
, Circle.task
33+
, Hamilton.task
34+
, Bipartit.task
35+
, Isomorphism.task
36+
, Structures.task
37+
]
1638

1739
app :: String -- ^ task type
1840
-> String -- ^ task description
1941
-> String -- ^ output
20-
app "set" d = Set.runTask d
21-
app "rel" d = Relation.runTask d
22-
app "struct" d = Structures.runTask d
23-
app "graph" d = Graphs.runTask d
24-
app "circle" d = Circle.runTask d
25-
app "hamilton" d = Hamilton.runTask d
26-
app "bipartit" d = Bipartit.runTask d
27-
app "iso" d = Isomorphism.runTask d
28-
app "al-model" d = StatementModel.runTask d
29-
app "al-equiv" d = StatementEquivalent.runTask d
30-
app "al-trans" d = StatementTransform.runTask d
31-
app "al-cnf" d = StatementCNF.runTask d
32-
app "al-dnf" d = StatementDNF.runTask d
33-
app s _ = unlines $ ("Undefined task type '" ++ s ++ "'. Supported task types are:") : taskDescriptions
42+
app t d = case findTask t of
43+
(Just t) -> runTask t d
44+
_ -> unknownTasktype t
45+
46+
taskHelp t = case findTask t of
47+
(Just t) -> describeTask t
48+
_ -> unknownTasktype t
3449

3550
help :: String
36-
help = unlines $ "USAGE: <task> <task description file>" : taskDescriptions
51+
help = unlines $
52+
[ "USAGE"
53+
, " <task> <task description file>"
54+
, " help <task>"
55+
, " help"
56+
, ""
57+
, "TASK TYPES"
58+
] ++ map ((" "++) . shortDescribeTask) tasks
59+
findTask t = find (compare t . name) tasks
60+
where compare = (==) `on` map toLower
3761

38-
taskDescriptions =
39-
[ " - set :: finds an expression matching a target value, given operators and constants"
40-
, " - rel :: finds an expression matching a target value, given operators and constants"
41-
, " - struct :: finds an expression with different value (semantic) in two structs"
42-
, " - graph :: finds an expression matching a target value, given operators and constants"
43-
, " - circle :: finds a circle of given length in a graph"
44-
, " - hamilton :: finds a hamilton path in a graph"
45-
, " - bipartit :: finds a set of vertices that split a graph into two bipartit subgraphs"
46-
, " - iso :: finds an isomorphism from one graph to another"
47-
, " - al-model :: finds a model for a statement of propositional logic"
48-
, " - al-equiv :: finds an equivalent statement by brute forcing"
49-
, " - al-trans :: finds an equivalent statement by fixed transformation rules"
50-
, " - al-cnf :: finds a semantically equivalent cnf for a given statement"
51-
, " - al-dnf :: finds a semantically equivalent dnf for a given statement"
52-
]
62+
unknownTasktype t = "Unknown task type '" ++ t ++ "'. Available tasks are:\n" ++ taskTypes
63+
where taskTypes = unlines $ map (\t -> " - " ++ name t) tasks

‎app/Main.hs

+9-3
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,15 @@
11
import System.Environment (getArgs)
2-
import App (app, help)
2+
import App (app, taskHelp, help)
3+
import Control.Exception (catch, handle, SomeException(..))
34

4-
main = getArgs >>= go >>= putStrLn
5+
main = do
6+
args <- getArgs
7+
out <- catch (go args) onError
8+
putStrLn out
59
where
10+
go ["help", taskname] = return $ taskHelp taskname
611
go [command,filename] = do
712
input <- readFile filename
813
return $ app command input
9-
go _ = return help
14+
go _ = return help
15+
onError e = return $ "ERROR\t" ++ show (e::Control.Exception.SomeException)

‎app/Task.hs

+52
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,52 @@
1+
module Task (Task(..), describeTask, shortDescribeTask) where
2+
3+
import Data.Text.Lazy (unpack)
4+
import Text.Pretty.Simple ( pShow, pShowOpt, defaultOutputOptionsNoColor, OutputOptions(..), pStringOpt )
5+
6+
data Task = Task
7+
{ runTask :: String -> String
8+
, name :: String
9+
, autotoolName :: String
10+
, description :: String
11+
, longDescription :: String
12+
, parameters :: [(String,String)]
13+
, exampleInput :: String
14+
}
15+
16+
shortDescribeTask :: Task -> String
17+
shortDescribeTask t = unwords
18+
[ name t ++ replicate (10 - length (name t)) ' '
19+
-- , "(" ++ autotoolName t ++ ")" ++ replicate (20 - length (autotoolName t)) ' '
20+
, ":: "
21+
, description t
22+
]
23+
24+
describeTask :: Task -> String
25+
describeTask t = unlines $
26+
[ ""
27+
, "TASK NAME"
28+
, "\t" ++ name t
29+
, ""
30+
, "AUTOTOOL NAME"
31+
, "\t" ++ autotoolName t
32+
, ""
33+
, "DESCRIPTION"
34+
, unlines $ map ("\t"++) $ lines (longDescription t)
35+
, ""
36+
, "PARAMETERS"
37+
]
38+
++ params ++
39+
[ ""
40+
, "EXAMPLE INPUT"
41+
, ""
42+
, "```"
43+
, unpack $ pStringOpt showOpt (exampleInput t)
44+
, "```"
45+
]
46+
where
47+
params = concatMap (\(k,v) -> [" - " ++ k,"\t" ++ v]) (parameters t)
48+
showOpt = defaultOutputOptionsNoColor {
49+
outputOptionsCompact = True,
50+
outputOptionsCompactParens = False,
51+
outputOptionsIndentAmount = 4
52+
}

‎app/Tasks/Bipartit.hs

+17-4
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,27 @@
1-
module Tasks.Bipartit (runTask) where
1+
module Tasks.Bipartit (task) where
22

3-
import Autotool.DAO
3+
import Task (Task(..))
4+
import Autotool.DAO ( DAO(toValue) )
45
import qualified Autotool.DAO.Graph as DAO ( Graph )
56
import Autotool.DAO.Set (mkSet)
67
import qualified Autotool.Data.Graph as G
78
import Autotool.Solver.Bipartit (solve)
89

10+
task :: Task
11+
task = Task
12+
{ runTask = run
13+
, name = "bipartit"
14+
, autotoolName = "Bipartit"
15+
, description = "Finds a set of vertices that split a graph into two bipartit subgraphs"
16+
, longDescription = "Finds a set of vertices that split a graph into two bipartit subgraphs"
17+
, parameters = [ ("graph", "The graph to split into two bipartit graphs") ]
18+
, exampleInput = show $ BipartitGraphsDescription
19+
{ graph = read "Graph { knoten = mkSet [ 0, 1, 2, 3] , kanten = mkSet [ kante 0 1 , kante 0 2 , kante 1 3 , kante 2 3 ] }"
20+
}
21+
}
922

10-
runTask :: String -> String
11-
runTask s = show $ mkSet $ solve g
23+
run :: String -> String
24+
run s = show $ mkSet $ solve g
1225
where
1326
desc = read s :: BipartitGraphsDescription
1427
g = toValue (graph desc) :: G.Graph Int

‎app/Tasks/Circle.hs

+18-4
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,28 @@
1-
module Tasks.Circle (runTask) where
1+
module Tasks.Circle (task) where
22

3-
import Autotool.DAO
3+
import Task (Task(..))
4+
import Autotool.DAO (toValue)
45
import qualified Autotool.DAO.Graph as DAO ( Graph )
56
import Autotool.DAO.Set (mkSet)
67
import qualified Autotool.Data.Graph as G
78
import Autotool.Solver.Circle (solve)
89

10+
task :: Task
11+
task = Task
12+
{ runTask = run
13+
, name = "circle"
14+
, autotoolName = "Kreis, Graph-Kreis"
15+
, description = "Finds a circle of given length in a graph"
16+
, longDescription = "Finds a circle of given length in a graph"
17+
, parameters = [ ("graph", "The graph to find a circle in"), ("length", "The lenght of the circle to find") ]
18+
, exampleInput = show $ CircleDescription
19+
{ graph = read "Graph { knoten = mkSet [ 1, 2, 3, 4, 5, 6] , kanten = mkSet [ kante 1 2 , kante 1 4 , kante 1 5 , kante 1 6 , kante 2 3 , kante 2 4 , kante 2 5 , kante 3 6 , kante 4 6 , kante 5 6 ] }"
20+
, Tasks.Circle.length = 4
21+
}
22+
}
923

10-
runTask :: String -> String
11-
runTask s = unlines $ map (show . mkSet) $ solve l g
24+
run :: String -> String
25+
run s = unlines $ map (show . mkSet) $ solve l g
1226
where
1327
desc = read s :: CircleDescription
1428
l = Tasks.Circle.length desc

‎app/Tasks/Graphs.hs

+23-4
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,33 @@
1-
module Tasks.Graphs (runTask) where
1+
module Tasks.Graphs (task) where
22

3+
import Task (Task(..))
34
import Autotool.Data.LazyTree (showTree, Op)
4-
import Autotool.DAO
5+
import Autotool.DAO ( toValue )
56
import qualified Autotool.DAO.Graph as DAO ( Graph, GraphConst, GraphOp )
67
import qualified Autotool.Data.Graph as G
78
import Autotool.Solver.Graphs (solve)
89

10+
task :: Task
11+
task = Task
12+
{ runTask = run
13+
, name = "graphs"
14+
, autotoolName = "Graph-Op"
15+
, description = "Finds an expression that evaluates to given graph"
16+
, longDescription = "Finds an expression that evaluates to given graph"
17+
, parameters =
18+
[ ("target", "The graph the searched expression should evaluate to")
19+
, ("graphs", "The given graphs the expression may contain")
20+
, ("operators", "The operators the expression may contain")
21+
]
22+
, exampleInput = show $ GraphsDescription
23+
{ target = read "Graph { knoten = mkSet [ 0 , 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9 , 10 ] , kanten = mkSet [ kante 0 6 , kante 0 7 , kante 0 8 , kante 0 9 , kante 1 6 , kante 1 7 , kante 1 8 , kante 1 9 , kante 2 6 , kante 2 7 , kante 2 8 , kante 2 9 , kante 3 6 , kante 3 7 , kante 3 8 , kante 3 9 , kante 4 6 , kante 4 7 , kante 4 8 , kante 4 9 , kante 5 6 , kante 5 7 , kante 5 8 , kante 5 9 , kante 6 8 , kante 7 9 ] }"
24+
, graphs = read "[ K1 , K2 , K3 , K4 , K5 , P3 , P4 , P5 , C3 , C4 , C5 ] "
25+
, ops = read "[ *, +, co]"
26+
}
27+
}
928

10-
runTask :: String -> String
11-
runTask s = showTree $ solve (consts ++ operators) t
29+
run :: String -> String
30+
run s = showTree $ solve (consts ++ operators) t
1231
where
1332
desc = read s :: GraphsDescription
1433
t = toValue $ target desc :: G.Graph Int

‎app/Tasks/Hamilton.hs

+20-4
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,29 @@
1-
module Tasks.Hamilton (runTask) where
1+
module Tasks.Hamilton (task) where
22

3-
import Autotool.DAO
3+
import Task (Task(..))
4+
import Autotool.DAO ( toValue )
45
import qualified Autotool.DAO.Graph as DAO ( Graph )
56
import qualified Autotool.Data.Graph as G
67
import Autotool.Solver.Hamilton (solve)
78

89

9-
runTask :: String -> String
10-
runTask s = show $ solve g
10+
11+
task :: Task
12+
task = Task
13+
{ runTask = run
14+
, name = "hamilton"
15+
, autotoolName = "Hamilton"
16+
, description = "Finds a hamilton path in a graph"
17+
, longDescription = "Finds a hamilton path in a graph"
18+
, parameters = [ ("graph", "The graph to find a circle in") ]
19+
, exampleInput = show $ HamiltonDescription
20+
{ graph = read "Graph { knoten = mkSet [ 1, 2, 3, 4, 5] , kanten = mkSet [ kante 1 2 , kante 1 4 , kante 1 5 , kante 2 3 , kante 2 4 , kante 3 4 , kante 3 5 , kante 4 5 ] }"
21+
}
22+
}
23+
24+
25+
run :: String -> String
26+
run s = show $ solve g
1127
where
1228
desc = read s :: HamiltonDescription
1329
g = toValue (graph desc) :: G.Graph Int

‎app/Tasks/Isomorphism.hs

+24-4
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,34 @@
1-
module Tasks.Isomorphism (runTask) where
1+
module Tasks.Isomorphism (task) where
22

3-
import Autotool.DAO
3+
import Task (Task(..))
4+
import Autotool.DAO (toValue)
45
import qualified Autotool.DAO.Graph as DAO ( Graph )
56
import Autotool.DAO.Map (mapToFM)
67
import qualified Autotool.Data.Graph as G
78
import Autotool.Solver.Isomorphism (solve)
89

910

10-
runTask :: String -> String
11-
runTask s = case solve g h of
11+
12+
task :: Task
13+
task = Task
14+
{ runTask = run
15+
, name = "iso"
16+
, autotoolName = "Graph-Iso"
17+
, description = "Finds an isomorphism from one graph to another"
18+
, longDescription = "Finds an isomorphism from one graph to another"
19+
, parameters =
20+
[ ("graph1", "The graph which is the source of the isomorphism")
21+
, ("graph2", "The graph which is the target of the isomorphism")
22+
]
23+
, exampleInput = show $ IsomorphismDescription
24+
{ graph1 = read "Graph { knoten = mkSet [ 0, 1, 2, 3] , kanten = mkSet [ kante 0 1 , kante 0 3 , kante 1 2 , kante 1 3 ] }"
25+
, graph2 = read "Graph { knoten = mkSet [ 0, 1, 2, 3] , kanten = mkSet [ kante 0 1 , kante 0 3 , kante 1 3 , kante 2 3 ] }"
26+
}
27+
}
28+
29+
30+
run :: String -> String
31+
run s = case solve g h of
1232
(Just iso) -> show $ mapToFM iso
1333
_ -> "ERROR: Cannot find an isomorphism from g to h"
1434
where

‎app/Tasks/Relations.hs

+23-3
Original file line numberDiff line numberDiff line change
@@ -1,15 +1,35 @@
1-
module Tasks.Relations (runTask) where
1+
module Tasks.Relations (task) where
22

33
import qualified Data.Set as S
4+
import Task (Task(..))
45
import Autotool.DAO (toValue)
56
import Autotool.DAO.Set (Set)
67
import Autotool.DAO.Relation (RelOp)
78
import Autotool.DAO.Identifier (Identifier)
89
import Autotool.Data.LazyTree (Op, mkOp0, showTree)
910
import Autotool.Solver.Relations (solveP)
1011

11-
runTask :: String -> String
12-
runTask input = showTree $ solveP (rops ++ ops) t
12+
task :: Task
13+
task = Task
14+
{ runTask = run
15+
, name = "rels"
16+
, autotoolName = "Rel, Relation"
17+
, description = "Finds an expression that evaluates to a given relation"
18+
, longDescription = "Finds an expression that evaluates to a given relation"
19+
, parameters =
20+
[ ("operators", "The operators the expression may contain")
21+
, ("sets", "The given relations the expression may contain")
22+
, ("target", "The value the expression should match.")
23+
]
24+
, exampleInput = show $ RelationDescription
25+
{ operators = read "[+, &, -, .]"
26+
, relations = read "[ (R, {(1 , 4) , (2 , 4) , (3 , 2) , (4 , 1)}), (S, {(1 , 4) , (2 , 2) , (2 , 3) , (4 , 4)}) ]"
27+
, target = read "{(1 , 1) , (1 , 4) , (2 , 1) , (2 , 2) , (2 , 4) , (4 , 1) , (4 , 4)}"
28+
}
29+
}
30+
31+
run :: String -> String
32+
run input = showTree $ solveP (rops ++ ops) t
1333
where
1434
desc = read input :: RelationDescription
1535
ops = (map toValue $ operators desc) :: [Op () (S.Set (Int,Int))]

0 commit comments

Comments
 (0)