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