1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139

------------------------------------------------------------------------------
--- This module contains operations implementing a file-based repository cache
--- for faster reading the repository. This file-based implementation
--- is used if the command `sqlite3` is not available (compare module
--- `CPM.RepositoryCache.Init`).
--- The repository cache contains reduced package specifications
--- for faster reading/writing by removing some information
--- which is not relevant for the repository data structure.
---
--- The relevant package fields are:
--- * small cache: name version dependencies compilerCompatibility
--- * large cache: synopsis category sourceDirs exportedModules executableSpec
---
--- @author Michael Hanus
--- @version December 2020
------------------------------------------------------------------------------

module CPM.Repository.CacheFile
  ( readRepository )
 where

import Data.Maybe       ( maybeToList, listToMaybe )

import System.Directory ( doesFileExist )
import System.IO
import ReadShowTerm     ( showQTerm, readQTerm, showTerm, readUnqualifiedTerm )

import CPM.Config        ( Config, repositoryDir )
import CPM.ConfigPackage ( packageVersion )
import CPM.ErrorLogger
import CPM.Package
import CPM.Repository

------------------------------------------------------------------------------
--- Reads all package specifications from the default repository.
--- Uses the cache if it is present or update the cache after reading.
--- If some errors occur, show them and terminate with error exit status.
---
--- @param cfg   - the configuration to use
--- @param large - if true reads the larger cache with more package information
---                (e.g., for searching all packages)
readRepository :: Config -> Bool -> ErrorLogger Repository
readRepository cfg large = do
  warnIfRepositoryOld cfg
  mbrepo <- readRepositoryCache cfg large
  case mbrepo of
    Nothing -> do
      repo <- readRepositoryFrom (repositoryDir cfg)
      logInfo $ "Writing " ++ (if large then "large" else "base") ++
                    " repository cache..."
      liftIOEL $ writeRepositoryCache cfg large repo
      return repo
    Just repo -> return repo


--- The file containing the repository cache as a Curry term.
repositoryCache :: Config -> Bool -> String
repositoryCache cfg large =
  repositoryCacheFilePrefix cfg ++ (if large then "_LARGE" else "_SMALL")

--- The first line of the repository cache (to check version compatibility):
repoCacheVersion :: String
repoCacheVersion = packageVersion ++ "-1"

--- Stores the given repository in the cache.
---
--- @param cfg   - the configuration to use
--- @param large - if true writes the larger cache with more package information
---                (e.g., for searching all packages)
--- @param repo  - the repository to write
writeRepositoryCache :: Config -> Bool -> Repository -> IO ()
writeRepositoryCache cfg large repo =
  writeFile (repositoryCache cfg large) $ unlines $
    repoCacheVersion :
    map (if large then showTerm . package2largetuple
                  else showTerm . package2smalltuple)
        (allPackages repo)
 where
  package2smalltuple p =
    ( name p, version p, dependencies p, compilerCompatibility p )

  package2largetuple p =
    (package2smalltuple p,
    (synopsis p, category p, sourceDirs p, exportedModules p,
     listToMaybe (executableSpec  p)))

--- Reads the given repository from the cache.
---
--- @param cfg   - the configuration to use
--- @param large - if true reads the larger cache with more package information
---                (e.g., for searching all packages)
readRepositoryCache :: Config -> Bool -> ErrorLogger (Maybe Repository)
readRepositoryCache cfg large = do
  let cf = repositoryCache cfg large
  excache <- liftIOEL $ doesFileExist cf
  if excache
    then do logDebug ("Reading repository cache from '" ++ cf ++ "'...")
            ((if large
                  then readTermInCacheFile cfg (largetuple2package . uread) cf
                  else readTermInCacheFile cfg (smalltuple2package . uread) cf)
                  >>= \repo ->
                logDebug "Finished reading repository cache" >> return repo)
              <|>
               (do logInfo "Cleaning broken repository cache..."
                   cleanRepositoryCache cfg
                   return Nothing )
    else return Nothing
 where
  uread s = readUnqualifiedTerm ["CPM.Package","Prelude"] s

  smalltuple2package (nm,vs,dep,cmp) =
    emptyPackage { name = nm
                 , version = vs
                 , dependencies = dep
                 , compilerCompatibility = cmp
                 }

  largetuple2package (basics,(sy,cat,srcs,exps,exec)) =
    (smalltuple2package basics)
      { synopsis = sy
      , category = cat
      , sourceDirs = srcs
      , exportedModules = exps
      , executableSpec  = maybeToList exec
      }

readTermInCacheFile :: Config -> (String -> Package) -> String
                    -> ErrorLogger (Maybe Repository)
readTermInCacheFile cfg trans cf = do
  h <- liftIOEL $ openFile cf ReadMode
  pv <- liftIOEL $ hGetLine h
  if pv == repoCacheVersion
    then liftIOEL (hGetContents h) >>= \t ->
         return $!! Just (pkgsToRepository (map trans (lines  t)))
    else do logInfo "Cleaning repository cache (wrong version)..."
            cleanRepositoryCache cfg
            return Nothing

------------------------------------------------------------------------------