DrIFT.hs revision f89a3a8a5f8f4c39570125a7c5e5da9a1c700d1c
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder{- | Based on DrIFT 1.0 by Noel Winstanley,
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiu hacked for Haskell 98 by Malcolm Wallace, University of York, Feb 1999,
e9458b1a7a19a63aa4c179f9ab20f4d50681c168Jens Elkner modified by various people, now maintained by John Meacham,
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiu adapted version for hets by Christian Maeder.
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiumodule Main (main) where
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiuimport ChaseImports
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiuimport UserRulesHetCATS
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiuimport RuleUtils (commentLine, texts, Rule, Tag)
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiuimport ParseLib2
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiuimport Data.List (partition)
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiuimport qualified System.Exit as System
a604cbad8e2202147b5c6bb9f2e06ae61162d654Felix Gabriel Manceimport qualified System.IO as IO
be2439588008221e691321fdf4f75432cfb72878Felix Gabriel Manceusage :: String
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiuusage = "Usage: DrIFT file\n"
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiu argv <- getArgs
0dd6e7830de0887c9a12356447975a826b3b3db2Christian Maeder [n] -> derive n
424860079d47bf490fa98d5d7498096a0447c569mcodescu $ "single input file must be specified.\n" ++ usage
1a38107941725211e7c3f051f7a8f5e12199f03acmaederderive :: FilePath -> IO ()
1a38107941725211e7c3f051f7a8f5e12199f03acmaederderive fname = do
32bbac77828be0233953f8fe476edb0a9585408dChristian Maeder fbody <- readFile fname
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiu let modname = case papply (parse (symbol "module" >> cap))
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiu (0, -1) ((0, 0), fbody) of
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiu _ -> error "module name not recognized"
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiu let (docs, _, todo) = process modname . parser $ fbody
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiu moreDocs <- fmap ((\ (x, _, _) -> x) . process modname)
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiu (chaseImports fbody todo)
431571057e88a650a974adec93ea4bb5173b6213Felix Gabriel Mance putStrLn "\n-- Generated by DrIFT, look but don't touch!\n"
1a38107941725211e7c3f051f7a8f5e12199f03acmaeder putStr . render . vsep $ docs ++ moreDocs
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiurules :: [(Tag, Data -> Doc)]
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiurules = map (\ (a, b, _, _, _) -> (a, b)) hetcatsrules
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiuvsep :: [Doc] -> Doc
b84c87f199dc287d235d7dad6ea344f6912ef531Christian Maedervsep = vcat . map ($$ text "")
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiu{- Main Pass - Takes parsed data and rules and combines to create instances...
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae BungiuReturns all parsed data, ande commands calling for files to be imported if
be00381168b3f10192afabbba136fb06d3a9f358Christian Maederdatatypes aren't located in this module. -}
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiuprocess :: String -> ToDo -> ([Doc], [Data], ToDo)
27fdf879983dd28e211b41f3be6c0e930b7c816bFelix Gabriel Manceprocess modname i =
7852de3551fc797566ee71165bafe05b6d81728cnotanartist (concatMap g dats ++ concatMap h moreDats, parsedData, fimports)
27fdf879983dd28e211b41f3be6c0e930b7c816bFelix Gabriel Mance g (tags, d) = [find t rules d | t <- tags ++ directives]
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiu h (tags, d) = [find t rules d | t <- tags]
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiu directives = concatMap fst globals
27fdf879983dd28e211b41f3be6c0e930b7c816bFelix Gabriel Mance (dats, commands) = partition (isData . snd) i
d0f58d27c2536eba454d8f77de8617bc6a2c99cdFelix Gabriel Mance (globals, fors) = partition (\ (_, d) -> d == Directive) commands
d0f58d27c2536eba454d8f77de8617bc6a2c99cdFelix Gabriel Mance (moreDats, fimports) = resolve modname parsedData fors ([], [])
d0f58d27c2536eba454d8f77de8617bc6a2c99cdFelix Gabriel Mance parsedData = map snd dats
431571057e88a650a974adec93ea4bb5173b6213Felix Gabriel Mancefind :: Tag -> [Rule] -> Data -> Doc
ee93ea764a2b8189253e912c8447f9419033f6d4Francisc Nicolae Bungiufind t r = case filter ((== t) . fst) r of
27fdf879983dd28e211b41f3be6c0e930b7c816bFelix Gabriel Mance x : _ -> snd x
424860079d47bf490fa98d5d7498096a0447c569mcodescu [] -> const $ commentLine
60f30f0eeeacdfc1e0dfe39664373ddf5a0675adFelix Gabriel Mance $ hsep . texts $ ["Warning : Rule", t, "not found."]