5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz{- |
e9458b1a7a19a63aa4c179f9ab20f4d50681c168Jens ElknerModule : ./HasCASL/MatchCAD.hs
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst SchulzDescription : MatchCAD program
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst SchulzCopyright : (c) Ewaryst Schulz, DFKI Bremen 2010
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst SchulzLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst SchulzMaintainer : ewaryst.schulz@dfki.de
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst SchulzStability : experimental
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst SchulzPortability : non-portable (via imports)
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst SchulzProgram for matching to HasCASL exported CAD designs against design patterns
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz-}
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulzimport System.Environment
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulzimport System.Console.GetOpt
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulzimport HasCASL.InteractiveTests
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulzimport Data.Bits
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulzimport Data.Maybe
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulzimport Data.List
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulzmain :: IO ()
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulzmain = do
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz args <- getArgs
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz case processArgs args of
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz Left msg -> putStrLn $ "Design Matching: " ++ msg ++ "\n\n" ++ dmUsage
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst Schulz Right st -> runProg st >>= putStrLn
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst Schulz
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst SchulzrunProg :: ProgSettings -> IO String
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst SchulzrunProg st
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst Schulz | translate st = matchTranslate (lib st) (spec st) (pattern st) $ design st
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst Schulz | otherwise = matchDesign (lib st) (spec st) (pattern st) $ design st
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder-- ----------------------- Input Arguments -------------------------
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst SchulzprocessArgs :: [String] -> Either String ProgSettings
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst SchulzprocessArgs args =
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz let (flags, noopts, unrecopts, errs) = getOpt' (ReturnInOrder PFLib) options args
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz msgl = checkFlags flags
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz f str (l, s) = if null l then str else str ++ "\n" ++ s ++ unlines l
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz msg = foldl f ""
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz [ (noopts, "non-handled extra arguments encountered ")
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , (unrecopts, "unrecognized flags encountered ")
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , (errs, "")
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , (msgl, "")
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz ]
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz in if null msg then Right $ getSettings flags else Left msg
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst SchulzdmHeader :: String
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst SchulzdmHeader = unlines
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst Schulz [ "Usage: matchcad [OPTION...] [file]"
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst Schulz , ""
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst Schulz , "matchcad /tmp/flange.het -sMatch -pFlangePattern -dComponent"
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst Schulz , ""
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst Schulz ]
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst Schulz
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst SchulzdmUsage :: String
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst SchulzdmUsage = usageInfo dmHeader options
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz{- | 'options' describes all available options and is used to generate usage
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulzinformation -}
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulzoptions :: [OptDescr ProgFlag]
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz -- Option [Char] [String] (ArgDescr a) String
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroederoptions = map f
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz [ ( "lib", "Path to the hets file", ReqArg PFLib "FILE")
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , ( "spec"
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , "Name of specification importing both, the pattern and the design specification"
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , ReqArg PFSpec "SPECNAME")
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , ( "pattern", "Name of the pattern specification"
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , ReqArg PFPattern "SPECNAME")
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , ( "design", "Name of the design specification"
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , ReqArg PFDesign "SPECNAME")
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst Schulz , ( "translate"
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst Schulz , "If this flag is set the match is further translated to an EnCL specification"
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst Schulz , NoArg PFTrans)
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , ( "verbosity"
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , "A value from 0=quiet to 4=print out all information during processing"
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder , OptArg (PFVerbosity . read . fromMaybe "4") "0-4")
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , ( "quiet", "Equal to -v0", NoArg PFQuiet)
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz ] where
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz f (fs, descr, arg) = Option [head fs] [fs] arg descr
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst SchulzcheckFlags :: [ProgFlag] -> [String]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroedercheckFlags = g . mapAccumL f (0 :: Int) where
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz f i (PFLib _) = (setBit i 0, ())
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz f i (PFSpec _) = (setBit i 1, ())
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz f i (PFPattern _) = (setBit i 2, ())
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz f i (PFDesign _) = (setBit i 3, ())
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz f i _ = (i, ())
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz g (i, _) = mapMaybe (h i) [ (0, "lib")
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , (1, "spec")
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , (2, "pattern")
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , (3, "design") ]
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz h i (j, s)
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz | testBit i j = Nothing
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz | otherwise = Just $ s ++ " argument is missing"
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulzdata ProgSettings =
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz ProgSettings
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz { lib :: String
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , spec :: String
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , pattern :: String
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , design :: String
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst Schulz , translate :: Bool
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , verbosity :: Int }
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst SchulzdefaultSettings :: ProgSettings
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst SchulzdefaultSettings = ProgSettings
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz { lib = error "uninitialized settings"
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , spec = error "uninitialized settings"
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , pattern = error "uninitialized settings"
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , design = error "uninitialized settings"
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst Schulz , translate = False
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz , verbosity = 4 }
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulzdata ProgFlag =
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz PFLib String
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz | PFSpec String
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz | PFPattern String
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz | PFDesign String
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz | PFVerbosity Int
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz | PFQuiet
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst Schulz | PFTrans
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst SchulzmakeSettings :: ProgSettings -> ProgFlag -> ProgSettings
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst SchulzmakeSettings settings flg =
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz case flg of
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz PFLib s -> settings { lib = s }
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz PFSpec s -> settings { spec = s }
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz PFPattern s -> settings { pattern = s }
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz PFDesign s -> settings { design = s }
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz PFVerbosity i -> settings { verbosity = i }
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst Schulz PFQuiet -> settings { verbosity = 0 }
293138b28842d590a5daa908db72ee70a9a505c8Ewaryst Schulz PFTrans -> settings { translate = True }
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst SchulzgetSettings :: [ProgFlag] -> ProgSettings
5dad1d101f19a24ec783767c720a9b36640a1222Ewaryst SchulzgetSettings = foldl makeSettings defaultSettings