Description : library names for HetCASL and development graphs
Copyright : (c) Christian Maeder, DFKI GmbH 2008
Maintainer : Christian.Maeder@dfki.de
Abstract syntax of HetCASL specification libraries
Follows Sect. II:2.2.5 of the CASL Reference Manual.
mkQualName :: SIMPLE_ID -> LibId -> Id -> Id
mkQualName nodeId libId i =
Id omTs [i, simpleIdToId nodeId, libIdToId libId] $ posOfId i
isQualNameFrom :: SIMPLE_ID -> LibId -> Id -> Bool
isQualNameFrom nodeId libId i@(Id _ cs _) = case cs of
_ : n : l : _ | isQualName i ->
n == simpleIdToId nodeId && libIdToId libId == l
isQualName (Id ts cs _) = case cs of
libIdOfQualName :: Id -> Id
libIdOfQualName j@(Id _ cs _) = case cs of
[_, _, i] | isQualName j -> i
_ -> error "libIdOfQualName: Check by isQualName before calling getLibId!"
getNodeId j@(Id _ cs _) = case cs of
[_, i, _] | isQualName j -> i
_ -> error "Check by isQualName before calling getNodeId!"
unQualName j@(Id _ cs _) = case cs of
i : _ | isQualName j -> i
path = splitOn '/' $ show li
toTok s = Token s $ getRange li
in mkId $ map toTok $ intersperse "/" path
, libVersion :: Maybe VersionNumber }
emptyLibName :: String -> LibName
emptyLibName s = LibName (IndirectLink s nullRange "" noTime) Nothing
data LibId = DirectLink URL Range
| IndirectLink PATH Range FilePath ClockTime
-- | Returns the LibId of a LibName
getModTime :: LibId -> ClockTime
getModTime li = case li of
IndirectLink _ _ _ m -> m
updFilePathOfLibId :: FilePath -> ClockTime -> LibId -> LibId
updFilePathOfLibId fp mt li = case li of
IndirectLink p r _ _ -> IndirectLink p r fp mt
data VersionNumber = VersionNumber [String] Range deriving (Show, Eq)
-- pos: "version", start of first string
instance GetRange LibId where
IndirectLink _ r _ _ -> r
instance Show LibId where
IndirectLink s1 _ _ _ -> s1
instance GetRange LibName where
getRange = getRange . getLibId
instance Show LibName where
show (LibName li mvs) = shows li $ case mvs of
Just (VersionNumber vs _) -> " version " ++ intercalate "." vs
DirectLink s1 _ == DirectLink s2 _ = s1 == s2
IndirectLink s1 _ _ _ == IndirectLink s2 _ _ _ = s1 == s2
DirectLink s1 _ <= DirectLink s2 _ = s1 <= s2
IndirectLink s1 _ _ _ <= IndirectLink s2 _ _ _ = s1 <= s2
DirectLink _ _ <= _ = True
IndirectLink _ _ _ _ <= _ = False
instance Eq LibName where
ln1 == ln2 = compare ln1 ln2 == EQ
instance Ord LibName where
compare ln1 ln2 = compare (getLibId ln1) $ getLibId ln2
instance Pretty LibName where
pretty (LibName i mv) = fsep $ pretty i : case mv of
Just (VersionNumber v _) -> [keyword versionS, pretty v]
instance Pretty LibId where
pretty l = structId $ case l of
IndirectLink p _ _ _ -> p
instance Pretty VersionNumber where
pretty (VersionNumber aa _) =
hcat $ punctuate dot $ map codeToken aa