tricu

An interpreted language for exploring Tree Calculus
Log | Files | Refs | README | LICENSE

Alias.hs (2534B)

      1 module ContentStore.Alias
      2   ( AliasKind(..)
      3   , ObjectRef(..)
      4   , aliasKindDirectory
      5   , writeAlias
      6   , readAlias
      7   , listAliases
      8   ) where
      9 
     10 import ContentStore.Filesystem (ensureStore)
     11 import ContentStore.Object
     12 
     13 import Data.Text (Text)
     14 import System.Directory (createDirectoryIfMissing, doesFileExist, listDirectory)
     15 import System.FilePath ((</>))
     16 
     17 import qualified Data.Text as Text
     18 import qualified Data.Text.IO as TextIO
     19 
     20 -- | Mutable workspace alias categories. Aliases are human-facing pointers to
     21 -- immutable content objects; they are not content identity.
     22 data AliasKind
     23   = NameAlias
     24   | ModuleAlias
     25   | PackageAlias
     26   deriving (Eq, Ord, Show)
     27 
     28 data ObjectRef = ObjectRef
     29   { objectRefKind :: Text
     30   , objectRefHash :: ObjectHash
     31   } deriving (Eq, Ord, Show)
     32 
     33 aliasKindDirectory :: AliasKind -> FilePath
     34 aliasKindDirectory NameAlias = "names"
     35 aliasKindDirectory ModuleAlias = "modules"
     36 aliasKindDirectory PackageAlias = "packages"
     37 
     38 writeAlias :: StorePath -> AliasKind -> Text -> ObjectRef -> IO ()
     39 writeAlias store@(StorePath root) kind name ref = do
     40   ensureStore store
     41   let dir = root </> "aliases" </> aliasKindDirectory kind
     42   createDirectoryIfMissing True dir
     43   TextIO.writeFile (dir </> Text.unpack name) (encodeObjectRef ref)
     44 
     45 readAlias :: StorePath -> AliasKind -> Text -> IO (Maybe ObjectRef)
     46 readAlias store@(StorePath root) kind name = do
     47   ensureStore store
     48   let path = root </> "aliases" </> aliasKindDirectory kind </> Text.unpack name
     49   exists <- doesFileExist path
     50   if not exists
     51     then return Nothing
     52     else decodeObjectRef <$> TextIO.readFile path
     53 
     54 listAliases :: StorePath -> AliasKind -> IO [(Text, ObjectRef)]
     55 listAliases store@(StorePath root) kind = do
     56   ensureStore store
     57   let dir = root </> "aliases" </> aliasKindDirectory kind
     58   names <- listDirectory dir
     59   fmap concat $ mapM load names
     60   where
     61     load name = do
     62       mRef <- readAlias store kind (Text.pack name)
     63       return $ maybe [] (\ref -> [(Text.pack name, ref)]) mRef
     64 
     65 encodeObjectRef :: ObjectRef -> Text
     66 encodeObjectRef ref = Text.unlines
     67   [ "kind: " <> objectRefKind ref
     68   , "hash: " <> objectRefHash ref
     69   ]
     70 
     71 decodeObjectRef :: Text -> Maybe ObjectRef
     72 decodeObjectRef txt = do
     73   kind <- lookupField "kind" fields
     74   hash <- lookupField "hash" fields
     75   return ObjectRef { objectRefKind = kind, objectRefHash = hash }
     76   where
     77     fields = map parseLine (Text.lines txt)
     78     parseLine line =
     79       let (k, rest) = Text.breakOn ":" line
     80       in (Text.strip k, Text.strip (Text.drop 1 rest))
     81     lookupField key = lookup key