Java/META/Spec.hs

   1 module Java.META.Spec where
   2
   3 import Control.Monad
   4 import Control.Monad.Error
   5 import qualified Data.Map as M
   6 import Data.Map ((!))
   7 import Data.Char (toLower)
   8
   9 import Java.META.Types
  10
  11 class MetaSpec s where
  12   loadFirstSection :: Section -> s
  13
  14   loadOtherSection :: s -> Section -> s
  15   loadOtherSection s _ = s
  16
  17   storeMeta :: s -> META
  18
  19 loadSpec :: (MetaSpec s) => META -> s
  20 loadSpec [] = error "Cannot load empty metadata"
  21 loadSpec (s:ss) =
  22   let x = loadFirstSection s
  23   in  foldl loadOtherSection x ss
  24
  25 lookupList :: String -> Maybe String -> [(String, String)]
  26 lookupList _ Nothing = []
  27 lookupList name (Just val) = [(name, val)]
  28
  29 bool2string :: Bool -> String
  30 bool2string True = "true"
  31 bool2string False = "false"
  32
  33 string2bool :: String -> Bool
  34 string2bool s
  35   | map toLower s == "true" = True
  36   | otherwise = False
  37
  38 data Manifest = Manifest {
  39   manifestVersion :: String,
  40   createdBy :: String,
  41   sealed :: Bool,
  42   signatureVersion :: Maybe String,
  43   classPath :: [String],
  44   mainClass :: Maybe String,
  45   manifestEntries :: [ManifestEntry]}
  46   deriving (Eq, Show)
  47
  48 data ManifestEntry = ManifestEntry {
  49   meName :: String,
  50   meSealed :: Bool,
  51   meContentType :: Maybe String,
  52   meBean :: Bool }
  53   deriving (Eq, Show)
  54
  55 instance MetaSpec Manifest where
  56   loadFirstSection s = Manifest {
  57     manifestVersion = s ! "Manifest-Version",
  58     createdBy = s ! "Created-By",
  59     sealed = case M.lookup "Sealed" s of
  60                Nothing -> False
  61                Just str -> string2bool str,
  62     signatureVersion = M.lookup "Signature-Version" s,
  63     classPath = case M.lookup "Class-Path" s of
  64                   Nothing -> []
  65                   Just str -> words str,
  66     mainClass = M.lookup "Main-Class" s,
  67     manifestEntries = []}
  68
  69   loadOtherSection m s = m {manifestEntries = manifestEntries m ++ [entry]}
  70     where
  71       entry = ManifestEntry {
  72                 meName = s ! "Name",
  73                 meSealed = case M.lookup "Sealed" s of
  74                              Nothing -> sealed m
  75                              Just str -> string2bool str,
  76                 meContentType = M.lookup "Content-Type" s,
  77                 meBean = case M.lookup "Java-Bean" s of
  78                            Nothing -> False
  79                            Just str -> string2bool str }
  80
  81   storeMeta m = first: map store (manifestEntries m)
  82     where
  83       first = M.fromList $ [
  84           ("Manifest-Version", manifestVersion m),
  85           ("Created-By", createdBy m)] ++
  86           lookupList "Signature-Version" (signatureVersion m) ++
  87           lookupList "Main-Class" (mainClass m) ++
  88           case classPath m of
  89             [] -> []
  90             list -> [("Class-Path", unwords list)]
  91
  92       store e = M.fromList $ [
  93           ("Name", meName e),
  94           ("Sealed", bool2string $ meSealed e)] ++
  95           lookupList "Content-Type" (meContentType e) ++
  96           if meBean e
  97             then [("Java-Bean", "true")]
  98             else []
  99