LibName.hs revision 831b0d8f47480be51d14f2cf122913507859f9c3
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian MaederModule : $Header$
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian MaederDescription : library names for HetCASL and development graphs
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian MaederCopyright : (c) Christian Maeder, DFKI GmbH 2008
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian MaederLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian MaederMaintainer : Christian.Maeder@dfki.de
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian MaederStability : provisional
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian MaederPortability : portable
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian MaederAbstract syntax of HetCASL specification libraries
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian Maeder Follows Sect. II:2.2.5 of the CASL Reference Manual.
0789323dfca89bae8f710da5bba20220b9af2feaChristian MaederomTs :: [Token]
0789323dfca89bae8f710da5bba20220b9af2feaChristian MaederomTs = [genToken "OM"]
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian MaedermkQualName :: SIMPLE_ID -> LibId -> Id -> Id
92dc581bf568c9e225aa9d0570ab0a4b6ebdab69Christian MaedermkQualName nodeId libId i =
0789323dfca89bae8f710da5bba20220b9af2feaChristian Maeder Id omTs [i, simpleIdToId nodeId, libIdToId libId] $ posOfId i
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian MaederisQualNameFrom :: SIMPLE_ID -> LibId -> Id -> Bool
248ab4f138caa9a594cd3fe0815e7fd4150701efChristian MaederisQualNameFrom nodeId libId i@(Id _ cs _) = case cs of
5dc46f6d0fdd8747d730f9e79a93978145ed43bbChristian Maeder _ : n : l : _ | isQualName i ->
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder n == simpleIdToId nodeId && libIdToId libId == l
0789323dfca89bae8f710da5bba20220b9af2feaChristian MaederisQualName :: Id -> Bool
0789323dfca89bae8f710da5bba20220b9af2feaChristian MaederisQualName (Id ts cs _) = case cs of
0789323dfca89bae8f710da5bba20220b9af2feaChristian Maeder _ : _ : _ -> ts == omTs
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian MaederlibIdOfQualName :: Id -> Id
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian MaederlibIdOfQualName j@(Id _ cs _) = case cs of
6df66a8a7be47ca0d9a4d15b89d3380c8e1f4aedEwaryst Schulz [_, _, i] | isQualName j -> i
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder _ -> error "libIdOfQualName: Check by isQualName before calling getLibId!"
6df66a8a7be47ca0d9a4d15b89d3380c8e1f4aedEwaryst SchulzgetNodeId :: Id -> Id
6df66a8a7be47ca0d9a4d15b89d3380c8e1f4aedEwaryst SchulzgetNodeId j@(Id _ cs _) = case cs of
6df66a8a7be47ca0d9a4d15b89d3380c8e1f4aedEwaryst Schulz [_, i, _] | isQualName j -> i
6df66a8a7be47ca0d9a4d15b89d3380c8e1f4aedEwaryst Schulz _ -> error "Check by isQualName before calling getNodeId!"
5dc46f6d0fdd8747d730f9e79a93978145ed43bbChristian MaederunQualName :: Id -> Id
5dc46f6d0fdd8747d730f9e79a93978145ed43bbChristian MaederunQualName j@(Id _ cs _) = case cs of
5dc46f6d0fdd8747d730f9e79a93978145ed43bbChristian Maeder i : _ | isQualName j -> i
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian MaederlibIdToId :: LibId -> Id
92dc581bf568c9e225aa9d0570ab0a4b6ebdab69Christian MaederlibIdToId li = let
92dc581bf568c9e225aa9d0570ab0a4b6ebdab69Christian Maeder path = splitOn '/' $ show li
92dc581bf568c9e225aa9d0570ab0a4b6ebdab69Christian Maeder toTok s = Token s $ getRange li
92dc581bf568c9e225aa9d0570ab0a4b6ebdab69Christian Maeder in mkId $ map toTok $ intersperse "/" path
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maederdata LibName = LibName
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder { getLibId :: LibId
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder , libVersion :: Maybe VersionNumber }
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian MaederemptyLibName :: String -> LibName
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian MaederemptyLibName s = LibName (IndirectLink s nullRange "" noTime) Nothing
b410420153cc9ac37fb4ebb86699cba7fa19bc35Christian Maeder DirectLink URL Range
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian Maeder -- pos: start of URL
b410420153cc9ac37fb4ebb86699cba7fa19bc35Christian Maeder | IndirectLink PATH Range FilePath ClockTime
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian Maeder -- pos: start of PATH
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian MaedernoTime :: ClockTime
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian MaedernoTime = TOD 0 0
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder-- | Returns the LibId of a LibName
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian MaedergetModTime :: LibId -> ClockTime
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian MaedergetModTime li = case li of
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder DirectLink _ _ -> noTime
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder IndirectLink _ _ _ m -> m
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian MaederupdFilePathOfLibId :: FilePath -> ClockTime -> LibId -> LibId
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian MaederupdFilePathOfLibId fp mt li = case li of
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder DirectLink _ _ -> li
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder IndirectLink p r _ _ -> IndirectLink p r fp mt
429df04296fa571432f62cbfad6855e1420e0fd6Christian MaedersetFilePath :: FilePath -> ClockTime -> LibName -> LibName
429df04296fa571432f62cbfad6855e1420e0fd6Christian MaedersetFilePath fp mt ln =
429df04296fa571432f62cbfad6855e1420e0fd6Christian Maeder ln { getLibId = updFilePathOfLibId fp mt $ getLibId ln }
b410420153cc9ac37fb4ebb86699cba7fa19bc35Christian Maederdata VersionNumber = VersionNumber [String] Range
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian Maeder -- pos: "version", start of first string
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian Maedertype URL = String
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian Maedertype PATH = String
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maederinstance GetRange LibId where
92dc581bf568c9e225aa9d0570ab0a4b6ebdab69Christian Maeder getRange li = case li of
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder DirectLink _ r -> r
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder IndirectLink _ r _ _ -> r
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maederinstance Show LibId where
92dc581bf568c9e225aa9d0570ab0a4b6ebdab69Christian Maeder show li = case li of
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder DirectLink s _ -> s
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder IndirectLink s1 _ _ _ -> s1
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maederinstance GetRange LibName where
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder getRange = getRange . getLibId
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maederinstance Show LibName where
54a535fb81b928ac8f99a11bdcfa8998533204a5Christian Maeder show = show . hsep . prettyLibName
b410420153cc9ac37fb4ebb86699cba7fa19bc35Christian MaederprettyVersionNumber :: VersionNumber -> [Doc]
b410420153cc9ac37fb4ebb86699cba7fa19bc35Christian MaederprettyVersionNumber (VersionNumber v _) =
b410420153cc9ac37fb4ebb86699cba7fa19bc35Christian Maeder [keyword versionS, hcat $ punctuate dot $ map codeToken v]
54a535fb81b928ac8f99a11bdcfa8998533204a5Christian MaederprettyLibName :: LibName -> [Doc]
54a535fb81b928ac8f99a11bdcfa8998533204a5Christian MaederprettyLibName (LibName i mv) = pretty i : case mv of
54a535fb81b928ac8f99a11bdcfa8998533204a5Christian Maeder Nothing -> []
54a535fb81b928ac8f99a11bdcfa8998533204a5Christian Maeder Just v -> prettyVersionNumber v
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maederinstance Eq LibId where
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder DirectLink s1 _ == DirectLink s2 _ = s1 == s2
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder IndirectLink s1 _ _ _ == IndirectLink s2 _ _ _ = s1 == s2
697e63e30aa3c309a1ef1f9357745111f8dfc5a9Christian Maeder _ == _ = False
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maederinstance Ord LibId where
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder DirectLink s1 _ <= DirectLink s2 _ = s1 <= s2
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder IndirectLink s1 _ _ _ <= IndirectLink s2 _ _ _ = s1 <= s2
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder DirectLink _ _ <= _ = True
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder IndirectLink _ _ _ _ <= _ = False
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maederinstance Eq LibName where
248ab4f138caa9a594cd3fe0815e7fd4150701efChristian Maeder ln1 == ln2 = compare ln1 ln2 == EQ
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maederinstance Ord LibName where
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maeder compare ln1 ln2 = compare (getLibId ln1) $ getLibId ln2
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maederinstance Pretty LibName where
54a535fb81b928ac8f99a11bdcfa8998533204a5Christian Maeder pretty = fsep . prettyLibName
e49fd57c63845c7806860a9736ad09f6d44dbaedChristian Maederinstance Pretty LibId where
54a535fb81b928ac8f99a11bdcfa8998533204a5Christian Maeder pretty = structId . show
10b1417752a7cd79344892ad4dbb14831851c638Ewaryst Schulz-- The Int type is used to represent Node, which is a typesynonym for Int.
10b1417752a7cd79344892ad4dbb14831851c638Ewaryst Schulz-- We can't use Node here
10b1417752a7cd79344892ad4dbb14831851c638Ewaryst Schulzdata LinkPath a = LinkPath a [(LibId, Node)] deriving (Ord, Eq)
831b0d8f47480be51d14f2cf122913507859f9c3Ewaryst Schulztype SLinkPath = LinkPath String
831b0d8f47480be51d14f2cf122913507859f9c3Ewaryst SchulzshowSLinkPath :: SLinkPath -> String
831b0d8f47480be51d14f2cf122913507859f9c3Ewaryst SchulzshowSLinkPath (LinkPath x l) = s l where
831b0d8f47480be51d14f2cf122913507859f9c3Ewaryst Schulz s ((_, n):l1) = s l1 ++ "/" ++ show n
e2e5830e2562de2f9a7daa31704fca25285180f0Ewaryst Schulzinstance Show a => Show (LinkPath a) where
831b0d8f47480be51d14f2cf122913507859f9c3Ewaryst Schulz show (LinkPath x l) = showSLinkPath $ LinkPath (show x) l
e2e5830e2562de2f9a7daa31704fca25285180f0Ewaryst Schulzinstance Functor LinkPath where
e2e5830e2562de2f9a7daa31704fca25285180f0Ewaryst Schulz fmap f (LinkPath x l) = LinkPath (f x) l
10b1417752a7cd79344892ad4dbb14831851c638Ewaryst SchulzaddToPath :: LibId -> Node -> LinkPath a -> LinkPath a
10b1417752a7cd79344892ad4dbb14831851c638Ewaryst SchulzaddToPath libid n (LinkPath x l) = LinkPath x $ (libid, n):l
10b1417752a7cd79344892ad4dbb14831851c638Ewaryst SchulzinitPath :: LibId -> Node -> a -> LinkPath a
10b1417752a7cd79344892ad4dbb14831851c638Ewaryst SchulzinitPath libid n x = LinkPath x [(libid, n)]