mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-22 07:48:10 +03:00
Merge branch 'trunk' into topic/more-tolerant-gitcache
This commit is contained in:
commit
de46c52d7f
28
.github/workflows/create-release.yaml
vendored
Normal file
28
.github/workflows/create-release.yaml
vendored
Normal file
@ -0,0 +1,28 @@
|
||||
name: "create-release"
|
||||
|
||||
on:
|
||||
push:
|
||||
tags:
|
||||
- "release/*"
|
||||
|
||||
jobs:
|
||||
release:
|
||||
name: "create-release"
|
||||
runs-on: "ubuntu-latest"
|
||||
|
||||
strategy:
|
||||
# Run each build to completion, regardless of if any have failed
|
||||
fail-fast: false
|
||||
steps:
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v2
|
||||
|
||||
|
||||
|
||||
- name: Create Release
|
||||
uses: softprops/action-gh-release@v1
|
||||
env:
|
||||
GITHUB_TOKEN: "${{ secrets.GITHUB_TOKEN }}"
|
||||
with:
|
||||
draft: true
|
||||
|
74
.github/workflows/upload-release-artifacts.yaml
vendored
Normal file
74
.github/workflows/upload-release-artifacts.yaml
vendored
Normal file
@ -0,0 +1,74 @@
|
||||
name: "upload-release-artifacts"
|
||||
|
||||
on:
|
||||
workflow_run:
|
||||
workflows: ["create-release"]
|
||||
types:
|
||||
- completed
|
||||
|
||||
jobs:
|
||||
release:
|
||||
name: ${{ matrix.os }}
|
||||
runs-on: ${{ matrix.os }}
|
||||
|
||||
strategy:
|
||||
# Run each build to completion, regardless of if any have failed
|
||||
fail-fast: false
|
||||
|
||||
matrix:
|
||||
os:
|
||||
- ubuntu-20.04
|
||||
- ubuntu-18.04
|
||||
- macOS-10.15
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v2
|
||||
|
||||
- name: install stack (Linux)
|
||||
if: runner.os == 'Linux'
|
||||
run: |
|
||||
curl -L https://github.com/commercialhaskell/stack/releases/download/v2.5.1/stack-2.5.1-linux-x86_64.tar.gz | tar -xz
|
||||
echo "$HOME/stack-2.5.1-linux-x86_64/" >> $GITHUB_PATH
|
||||
- name: install stack (macOS)
|
||||
if: runner.os == 'macOS'
|
||||
run: |
|
||||
curl -L https://github.com/commercialhaskell/stack/releases/download/v2.5.1/stack-2.5.1-osx-x86_64.tar.gz | tar -xz
|
||||
echo "$HOME/stack-2.5.1-osx-x86_64/" >> $GITHUB_PATH
|
||||
|
||||
|
||||
# One of the transcripts fails if the user's git name hasn't been set.
|
||||
- name: set git user info
|
||||
run: |
|
||||
git config --global user.name "GitHub Actions"
|
||||
git config --global user.email "actions@github.com"
|
||||
|
||||
- name: remove ~/.stack/setup-exe-cache on macOS
|
||||
if: runner.os == 'macOS'
|
||||
run: rm -rf ~/.stack/setup-exe-cache
|
||||
|
||||
- name: build
|
||||
run: stack --no-terminal build --flag unison-parser-typechecker:optimized
|
||||
|
||||
- name: fetch latest codebase-ui and package with ucm
|
||||
run: |
|
||||
mkdir -p /tmp/ucm/ui
|
||||
UCM=$(stack path | awk '/local-install-root/{print $2}')/bin/unison
|
||||
cp $UCM /tmp/ucm/ucm
|
||||
wget -O/tmp/ucm.zip https://github.com/unisonweb/codebase-ui/releases/download/latest/ucm.zip
|
||||
unzip -d /tmp/ucm/ui /tmp/ucm.zip
|
||||
tar -c -z -f unison-${{runner.os}}.tar.gz -C /tmp/ucm .
|
||||
|
||||
- name: Set env
|
||||
if: runner.os == 'macOS'
|
||||
run: echo "RELEASE_VERSION=release/${GITHUB_REF#refs/tags/release/*}-${{runner.os}}" >> $GITHUB_ENV
|
||||
|
||||
- name: Set env
|
||||
if: runner.os != 'macOS'
|
||||
run: echo "RELEASE_VERSION=release/${GITHUB_REF#refs/tags/release/*}-${{matrix.os}}" >> $GITHUB_ENV
|
||||
|
||||
- name: "Upload ${{matrix.os}}"
|
||||
uses: "actions/upload-artifact@v2"
|
||||
with:
|
||||
path: "unison-${{runner.os}}.tar.gz"
|
||||
env:
|
||||
GITHUB_TOKEN: "${{ secrets.GITHUB_TOKEN }}"
|
@ -51,3 +51,4 @@ The format for this list: name, GitHub handle, and then optional blurb about wha
|
||||
* Sam Roberts (@samgqroberts)
|
||||
* Nigel Farrelly (@nini-faroux)
|
||||
* Johannes Huster (@JohannesHuster)
|
||||
* Joseph Morag (@jmorag)
|
||||
|
15
codebase2/codebase-sqlite/U/Codebase/Sqlite/Connection.hs
Normal file
15
codebase2/codebase-sqlite/U/Codebase/Sqlite/Connection.hs
Normal file
@ -0,0 +1,15 @@
|
||||
module U.Codebase.Sqlite.Connection where
|
||||
|
||||
import qualified Database.SQLite.Simple as Sqlite
|
||||
|
||||
data Connection = Connection {name :: String, file :: FilePath, underlying :: Sqlite.Connection}
|
||||
|
||||
instance Show Connection where
|
||||
show (Connection name file underlying) =
|
||||
"Connection " ++ show name
|
||||
++ (if showFile then " " ++ file else mempty)
|
||||
++ (if showHandle then " " ++ show (Sqlite.connectionHandle underlying) else mempty)
|
||||
|
||||
showFile, showHandle :: Bool
|
||||
showFile = False
|
||||
showHandle = False
|
@ -48,7 +48,6 @@ import Data.Traversable (for)
|
||||
import Data.Tuple.Extra (uncurry3)
|
||||
import qualified Data.Vector as Vector
|
||||
import Data.Word (Word64)
|
||||
import Database.SQLite.Simple (Connection)
|
||||
import Debug.Trace
|
||||
import GHC.Stack (HasCallStack)
|
||||
import qualified U.Codebase.Branch as C.Branch
|
||||
@ -71,6 +70,7 @@ import qualified U.Codebase.Sqlite.Branch.Format as S.BranchFormat
|
||||
import qualified U.Codebase.Sqlite.Branch.Full as S
|
||||
import qualified U.Codebase.Sqlite.Branch.Full as S.Branch.Full
|
||||
import qualified U.Codebase.Sqlite.Branch.Full as S.MetadataSet
|
||||
import U.Codebase.Sqlite.Connection (Connection)
|
||||
import qualified U.Codebase.Sqlite.DbId as Db
|
||||
import qualified U.Codebase.Sqlite.Decl.Format as S.Decl
|
||||
import U.Codebase.Sqlite.LocalIds
|
||||
|
@ -23,6 +23,7 @@ import Control.Monad.Except (MonadError)
|
||||
import qualified Control.Monad.Except as Except
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import Control.Monad.Reader (MonadReader (ask))
|
||||
import qualified Control.Monad.Reader as Reader
|
||||
import Control.Monad.Trans (MonadIO (liftIO))
|
||||
import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT)
|
||||
import qualified Control.Monad.Writer as Writer
|
||||
@ -40,8 +41,7 @@ import Data.String (fromString)
|
||||
import Data.String.Here.Uninterpolated (here, hereFile)
|
||||
import Data.Text (Text)
|
||||
import Database.SQLite.Simple
|
||||
( Connection,
|
||||
FromRow,
|
||||
( FromRow,
|
||||
Only (..),
|
||||
ToRow (..),
|
||||
(:.) (..),
|
||||
@ -54,6 +54,8 @@ import GHC.Stack (HasCallStack)
|
||||
import Safe (headMay)
|
||||
import U.Codebase.HashTags (BranchHash (..), CausalHash (..))
|
||||
import U.Codebase.Reference (Reference')
|
||||
import U.Codebase.Sqlite.Connection (Connection)
|
||||
import qualified U.Codebase.Sqlite.Connection as Connection
|
||||
import U.Codebase.Sqlite.DbId
|
||||
( BranchHashId (..),
|
||||
BranchObjectId (..),
|
||||
@ -76,7 +78,6 @@ import U.Util.Hash (Hash)
|
||||
import qualified U.Util.Hash as Hash
|
||||
import UnliftIO (MonadUnliftIO, throwIO, try, tryAny, withRunInIO)
|
||||
import UnliftIO.Concurrent (myThreadId)
|
||||
|
||||
-- * types
|
||||
|
||||
type DB m = (MonadIO m, MonadReader Connection m)
|
||||
@ -85,11 +86,10 @@ type EDB m = (DB m, Err m)
|
||||
|
||||
type Err m = (MonadError Integrity m, HasCallStack)
|
||||
|
||||
debugQuery, debugThread, debugConnection, debugFile :: Bool
|
||||
debugQuery, debugThread, debugConnection :: Bool
|
||||
debugQuery = False
|
||||
debugThread = False
|
||||
debugConnection = False
|
||||
debugFile = False
|
||||
|
||||
alwaysTraceOnCrash :: Bool
|
||||
alwaysTraceOnCrash = True
|
||||
@ -144,7 +144,7 @@ setFlags = do
|
||||
|
||||
{- ORMOLU_DISABLE -}
|
||||
schemaVersion :: DB m => m SchemaVersion
|
||||
schemaVersion = queryAtoms sql () >>= \case
|
||||
schemaVersion = queryAtoms_ sql >>= \case
|
||||
[] -> error $ show NoSchemaVersion
|
||||
[v] -> pure v
|
||||
vs -> error $ show (MultipleSchemaVersions vs)
|
||||
@ -595,7 +595,7 @@ before chId1 chId2 = fmap fromOnly . queryOne $ queryMaybe sql (chId2, chId1)
|
||||
-- the `Connection` arguments come second to fit the shape of Exception.bracket + uncurry curry
|
||||
lca :: CausalHashId -> CausalHashId -> Connection -> Connection -> IO (Maybe CausalHashId)
|
||||
lca x y _ _ | debugQuery && trace ("Q.lca " ++ show x ++ " " ++ show y) False = undefined
|
||||
lca x y cx cy = Exception.bracket open close \(sx, sy) -> do
|
||||
lca x y (Connection.underlying -> cx) (Connection.underlying -> cy) = Exception.bracket open close \(sx, sy) -> do
|
||||
SQLite.bind sx (Only x)
|
||||
SQLite.bind sy (Only y)
|
||||
let getNext = (,) <$> SQLite.nextRow sx <*> SQLite.nextRow sy
|
||||
@ -643,6 +643,10 @@ ancestorSql = [here|
|
||||
queryAtoms :: (DB f, ToRow q, FromField b, Show q, Show b) => SQLite.Query -> q -> f [b]
|
||||
queryAtoms q r = map fromOnly <$> query q r
|
||||
|
||||
-- | no input, atomic List output
|
||||
queryAtoms_ :: (DB f, FromField b, Show b) => SQLite.Query -> f [b]
|
||||
queryAtoms_ q = map fromOnly <$> query_ q
|
||||
|
||||
-- | composite input, composite Maybe output
|
||||
queryMaybe :: (DB f, ToRow q, FromRow b, Show q, Show b) => SQLite.Query -> q -> f (Maybe b)
|
||||
queryMaybe q r = headMay <$> query q r
|
||||
@ -658,23 +662,21 @@ queryOne = fmap fromJust
|
||||
-- | composite input, composite List output
|
||||
query :: (DB m, ToRow q, FromRow r, Show q, Show r) => SQLite.Query -> q -> m [r]
|
||||
query q r = do
|
||||
c <- ask
|
||||
c <- Reader.reader Connection.underlying
|
||||
header <- debugHeader
|
||||
when debugFile traceConnectionFile
|
||||
liftIO . queryTrace (header ++ " query") q r $ SQLite.query c q r
|
||||
|
||||
-- | no input, composite List output
|
||||
query_ :: (DB m, FromRow r, Show r) => SQLite.Query -> m [r]
|
||||
query_ q = do
|
||||
c <- ask
|
||||
c <- Reader.reader Connection.underlying
|
||||
header <- debugHeader
|
||||
when debugFile traceConnectionFile
|
||||
liftIO . queryTrace_ (header ++ " query") q $ SQLite.query_ c q
|
||||
|
||||
debugHeader :: DB m => m String
|
||||
debugHeader = fmap (List.intercalate ", ") $ Writer.execWriterT do
|
||||
when debugThread $ Writer.tell . pure . show =<< myThreadId
|
||||
when debugConnection $ Writer.tell . pure . show . SQLite.connectionHandle =<< ask
|
||||
when debugConnection $ Writer.tell . pure . show =<< ask
|
||||
|
||||
queryTrace :: (MonadUnliftIO m, Show q, Show a) => String -> SQLite.Query -> q -> m a -> m a
|
||||
queryTrace title query input m = do
|
||||
@ -684,7 +686,8 @@ queryTrace title query input m = do
|
||||
do
|
||||
try @_ @SQLite.SQLError m >>= \case
|
||||
Right a -> do
|
||||
when debugQuery . traceM $ showInput ++ "\n output: " ++ show a
|
||||
when debugQuery . traceM $ showInput ++
|
||||
if " execute" `List.isSuffixOf` title then mempty else "\n output: " ++ show a
|
||||
pure a
|
||||
Left e -> do
|
||||
traceM $ showInput ++ "\n(and crashed)\n"
|
||||
@ -697,7 +700,8 @@ queryTrace_ title query m =
|
||||
then
|
||||
tryAny @_ m >>= \case
|
||||
Right a -> do
|
||||
when debugQuery . traceM $ title ++ " " ++ show query ++ "\n output: " ++ show a
|
||||
when debugQuery . traceM $ title ++ " " ++ show query ++
|
||||
if " execute_" `List.isSuffixOf` title then mempty else "\n output: " ++ show a
|
||||
pure a
|
||||
Left e -> do
|
||||
traceM $ title ++ " " ++ show query ++ "\n(and crashed)\n"
|
||||
@ -706,36 +710,33 @@ queryTrace_ title query m =
|
||||
|
||||
traceConnectionFile :: DB m => m ()
|
||||
traceConnectionFile = do
|
||||
c <- ask
|
||||
c <- Reader.reader Connection.underlying
|
||||
liftIO (SQLite.query_ c "PRAGMA database_list;") >>= \case
|
||||
[(_seq :: Int, _name :: String, file)] -> traceM file
|
||||
x -> error $ show x
|
||||
|
||||
execute :: (DB m, ToRow q, Show q) => SQLite.Query -> q -> m ()
|
||||
execute q r = do
|
||||
c <- ask
|
||||
c <- Reader.reader Connection.underlying
|
||||
header <- debugHeader
|
||||
when debugFile traceConnectionFile
|
||||
liftIO . queryTrace (header ++ " " ++ "execute") q r $ SQLite.execute c q r
|
||||
|
||||
execute_ :: DB m => SQLite.Query -> m ()
|
||||
execute_ q = do
|
||||
c <- ask
|
||||
c <- Reader.reader Connection.underlying
|
||||
header <- debugHeader
|
||||
when debugFile traceConnectionFile
|
||||
liftIO . queryTrace_ (header ++ " " ++ "execute_") q $ SQLite.execute_ c q
|
||||
|
||||
executeMany :: (DB m, ToRow q, Show q) => SQLite.Query -> [q] -> m ()
|
||||
executeMany q r = do
|
||||
c <- ask
|
||||
c <- Reader.reader Connection.underlying
|
||||
header <- debugHeader
|
||||
when debugFile traceConnectionFile
|
||||
liftIO . queryTrace (header ++ " " ++ "executeMany") q r $ SQLite.executeMany c q r
|
||||
|
||||
-- | transaction that blocks
|
||||
withImmediateTransaction :: (DB m, MonadUnliftIO m) => m a -> m a
|
||||
withImmediateTransaction action = do
|
||||
c <- ask
|
||||
c <- Reader.reader Connection.underlying
|
||||
withRunInIO \run -> SQLite.withImmediateTransaction c (run action)
|
||||
|
||||
|
||||
|
@ -29,10 +29,10 @@ import Data.List.Extra (nubOrd)
|
||||
import Data.Maybe (catMaybes, fromMaybe)
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
import Database.SQLite.Simple (Connection)
|
||||
import Debug.Trace (traceM, trace)
|
||||
import qualified U.Codebase.Reference as Reference
|
||||
import qualified U.Codebase.Sqlite.Branch.Format as BL
|
||||
import U.Codebase.Sqlite.Connection (Connection)
|
||||
import U.Codebase.Sqlite.DbId
|
||||
import qualified U.Codebase.Sqlite.LocalIds as L
|
||||
import qualified U.Codebase.Sqlite.ObjectType as OT
|
||||
|
@ -4,7 +4,7 @@ cabal-version: 1.12
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 1ebfb83fff5576c08030523940c272f5edfa0f42248d67da4edc9aa6d887cf5f
|
||||
-- hash: 3106bd32bedf162883882818669a81a3e1ca7c60af26ec9cd945fadb39f0d5aa
|
||||
|
||||
name: unison-codebase-sqlite
|
||||
version: 0.0.0
|
||||
@ -23,6 +23,7 @@ library
|
||||
U.Codebase.Sqlite.Branch.Diff
|
||||
U.Codebase.Sqlite.Branch.Format
|
||||
U.Codebase.Sqlite.Branch.Full
|
||||
U.Codebase.Sqlite.Connection
|
||||
U.Codebase.Sqlite.DbId
|
||||
U.Codebase.Sqlite.Decl.Format
|
||||
U.Codebase.Sqlite.JournalMode
|
||||
|
@ -21,7 +21,7 @@ ghc-options: -Wall -O0 -fno-warn-name-shadowing -fno-warn-missing-pattern-synony
|
||||
flags:
|
||||
optimized:
|
||||
manual: true
|
||||
default: false
|
||||
default: true
|
||||
|
||||
when:
|
||||
- condition: flag(optimized)
|
||||
|
@ -33,10 +33,10 @@ import qualified Data.Map as Map
|
||||
import Data.Maybe (catMaybes)
|
||||
import qualified Data.Set as Set
|
||||
import Data.Traversable (for)
|
||||
import Database.SQLite.Simple (Connection)
|
||||
import Debug.Trace (traceM)
|
||||
import System.IO (stdout)
|
||||
import System.IO.Extra (hFlush)
|
||||
import U.Codebase.Sqlite.Connection (Connection)
|
||||
import U.Codebase.Sync (Sync (Sync), TrySyncResult)
|
||||
import qualified U.Codebase.Sync as Sync
|
||||
import qualified U.Util.Monoid as Monoid
|
||||
|
@ -34,9 +34,9 @@ syncWatchKinds = [WK.TestWatch]
|
||||
upgradeCodebase :: forall m. (MonadIO m, MonadCatch m) => CodebasePath -> m ()
|
||||
upgradeCodebase root = do
|
||||
either (liftIO . CT.putPrettyLn) pure =<< runExceptT do
|
||||
(cleanupSrc, srcCB) <- ExceptT $ Codebase.openCodebase FC.init root
|
||||
(cleanupDest, destCB) <- ExceptT $ Codebase.createCodebase SC.init root
|
||||
destDB <- SC.unsafeGetConnection root
|
||||
(cleanupSrc, srcCB) <- ExceptT $ Codebase.openCodebase FC.init "upgradeCodebase srcCB" root
|
||||
(cleanupDest, destCB) <- ExceptT $ Codebase.createCodebase SC.init "upgradeCodebase destCB" root
|
||||
destDB <- SC.unsafeGetConnection "upgradeCodebase destDB" root
|
||||
let env = Sync12.Env srcCB destCB destDB
|
||||
let initialState = (Sync12.emptyDoneCount, Sync12.emptyErrorCount, Sync12.emptyStatus)
|
||||
rootEntity <-
|
||||
@ -62,6 +62,7 @@ upgradeCodebase root = do
|
||||
Just (Sync12.BranchReplaced _h' c') -> pure c'
|
||||
Nothing -> error "We didn't sync the root?"
|
||||
_ -> error "The root wasn't a causal?"
|
||||
SC.shutdownConnection destDB
|
||||
lift cleanupSrc
|
||||
lift cleanupDest
|
||||
pure ()
|
||||
|
@ -9,6 +9,7 @@ module Unison.Codebase.FileCodebase
|
||||
(
|
||||
codebase1', -- used by Test/Git
|
||||
Unison.Codebase.FileCodebase.init,
|
||||
openCodebase -- since init requires a bunch of irrelevant args now
|
||||
)
|
||||
where
|
||||
|
||||
@ -94,8 +95,8 @@ import UnliftIO.STM (atomically)
|
||||
|
||||
init :: (MonadIO m, MonadCatch m) => Codebase.Init m Symbol Ann
|
||||
init = Codebase.Init
|
||||
((fmap . fmap) (pure (),) . openCodebase)
|
||||
((fmap . fmap) (pure (),) . createCodebase)
|
||||
(const $ (fmap . fmap) (pure (),) . openCodebase)
|
||||
(const $ (fmap . fmap) (pure (),) . createCodebase)
|
||||
(</> Common.codebasePath)
|
||||
|
||||
|
||||
|
@ -3,7 +3,6 @@
|
||||
|
||||
module Unison.Codebase.Init where
|
||||
|
||||
import qualified Data.Text as Text
|
||||
import System.Exit (exitFailure)
|
||||
import Unison.Codebase (Codebase, CodebasePath)
|
||||
import qualified Unison.Codebase as Codebase
|
||||
@ -13,7 +12,6 @@ import qualified Unison.PrettyTerminal as PT
|
||||
import Unison.Symbol (Symbol)
|
||||
import qualified Unison.Util.Pretty as P
|
||||
import UnliftIO.Directory (canonicalizePath)
|
||||
import UnliftIO.Environment (getProgName)
|
||||
|
||||
type Pretty = P.Pretty P.ColorText
|
||||
|
||||
@ -21,20 +19,22 @@ data CreateCodebaseError
|
||||
= CreateCodebaseAlreadyExists
|
||||
| CreateCodebaseOther Pretty
|
||||
|
||||
type DebugName = String
|
||||
|
||||
data Init m v a = Init
|
||||
{ -- | open an existing codebase
|
||||
openCodebase :: CodebasePath -> m (Either Pretty (m (), Codebase m v a)),
|
||||
openCodebase :: DebugName -> CodebasePath -> m (Either Pretty (m (), Codebase m v a)),
|
||||
-- | create a new codebase
|
||||
createCodebase' :: CodebasePath -> m (Either CreateCodebaseError (m (), Codebase m v a)),
|
||||
createCodebase' :: DebugName -> CodebasePath -> m (Either CreateCodebaseError (m (), Codebase m v a)),
|
||||
-- | given a codebase root, and given that the codebase root may have other junk in it,
|
||||
-- give the path to the "actual" files; e.g. what a forked transcript should clone.
|
||||
codebasePath :: CodebasePath -> CodebasePath
|
||||
}
|
||||
|
||||
createCodebase :: MonadIO m => Init m v a -> CodebasePath -> m (Either Pretty (m (), Codebase m v a))
|
||||
createCodebase cbInit path = do
|
||||
createCodebase :: MonadIO m => Init m v a -> DebugName -> CodebasePath -> m (Either Pretty (m (), Codebase m v a))
|
||||
createCodebase debugName cbInit path = do
|
||||
prettyDir <- P.string <$> canonicalizePath path
|
||||
createCodebase' cbInit path <&> mapLeft \case
|
||||
createCodebase' debugName cbInit path <&> mapLeft \case
|
||||
CreateCodebaseAlreadyExists ->
|
||||
P.wrap $
|
||||
"It looks like there's already a codebase in: "
|
||||
@ -49,42 +49,12 @@ createCodebase cbInit path = do
|
||||
|
||||
-- * compatibility stuff
|
||||
|
||||
-- | load an existing codebase or exit.
|
||||
getCodebaseOrExit :: MonadIO m => Init m v a -> Maybe CodebasePath -> m (m (), Codebase m v a)
|
||||
getCodebaseOrExit init mdir = do
|
||||
dir <- Codebase.getCodebaseDir mdir
|
||||
openCodebase init dir >>= \case
|
||||
Left _e -> liftIO do
|
||||
progName <- getProgName
|
||||
prettyDir <- P.string <$> canonicalizePath dir
|
||||
PT.putPrettyLn' $ getNoCodebaseErrorMsg ((P.text . Text.pack) progName) prettyDir mdir
|
||||
exitFailure
|
||||
Right x -> pure x
|
||||
where
|
||||
getNoCodebaseErrorMsg :: IsString s => P.Pretty s -> P.Pretty s -> Maybe FilePath -> P.Pretty s
|
||||
getNoCodebaseErrorMsg executable prettyDir mdir =
|
||||
let secondLine =
|
||||
case mdir of
|
||||
Just dir ->
|
||||
"Run `" <> executable <> " -codebase " <> fromString dir
|
||||
<> " init` to create one, then try again!"
|
||||
Nothing ->
|
||||
"Run `" <> executable <> " init` to create one there,"
|
||||
<> " then try again;"
|
||||
<> " or `"
|
||||
<> executable
|
||||
<> " -codebase <dir>` to load a codebase from someplace else!"
|
||||
in P.lines
|
||||
[ "No codebase exists in " <> prettyDir <> ".",
|
||||
secondLine
|
||||
]
|
||||
|
||||
-- previously: initCodebaseOrExit :: CodebasePath -> m (m (), Codebase m v a)
|
||||
-- previously: FileCodebase.initCodebase :: CodebasePath -> m (m (), Codebase m v a)
|
||||
openNewUcmCodebaseOrExit :: MonadIO m => Init m Symbol Ann -> CodebasePath -> m (m (), Codebase m Symbol Ann)
|
||||
openNewUcmCodebaseOrExit cbInit path = do
|
||||
openNewUcmCodebaseOrExit :: MonadIO m => Init m Symbol Ann -> DebugName -> CodebasePath -> m (m (), Codebase m Symbol Ann)
|
||||
openNewUcmCodebaseOrExit debugName cbInit path = do
|
||||
prettyDir <- P.string <$> canonicalizePath path
|
||||
createCodebase cbInit path >>= \case
|
||||
createCodebase debugName cbInit path >>= \case
|
||||
Left error -> liftIO $ PT.putPrettyLn' error >> exitFailure
|
||||
Right x@(_, codebase) -> do
|
||||
liftIO $
|
||||
@ -96,6 +66,6 @@ openNewUcmCodebaseOrExit cbInit path = do
|
||||
pure x
|
||||
|
||||
-- | try to init a codebase where none exists and then exit regardless (i.e. `ucm -codebase dir init`)
|
||||
initCodebaseAndExit :: MonadIO m => Init m Symbol Ann -> Maybe CodebasePath -> m ()
|
||||
initCodebaseAndExit i mdir =
|
||||
void $ openNewUcmCodebaseOrExit i =<< Codebase.getCodebaseDir mdir
|
||||
initCodebaseAndExit :: MonadIO m => Init m Symbol Ann -> DebugName -> Maybe CodebasePath -> m ()
|
||||
initCodebaseAndExit i debugName mdir =
|
||||
void $ openNewUcmCodebaseOrExit i debugName =<< Codebase.getCodebaseDir mdir
|
||||
|
@ -6,7 +6,12 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
module Unison.Codebase.SqliteCodebase (Unison.Codebase.SqliteCodebase.init, unsafeGetConnection) where
|
||||
module Unison.Codebase.SqliteCodebase
|
||||
( Unison.Codebase.SqliteCodebase.init,
|
||||
unsafeGetConnection,
|
||||
shutdownConnection,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Control.Concurrent
|
||||
import qualified Control.Exception
|
||||
@ -22,6 +27,7 @@ import Control.Monad.Trans (MonadTrans (lift))
|
||||
import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
|
||||
import Data.Bifunctor (Bifunctor (bimap, first), second)
|
||||
import qualified Data.Either.Combinators as Either
|
||||
import qualified Data.Char as Char
|
||||
import Data.Foldable (Foldable (toList), for_, traverse_)
|
||||
import Data.Functor (void, (<&>), ($>))
|
||||
import qualified Data.List as List
|
||||
@ -35,7 +41,6 @@ import qualified Data.Text as Text
|
||||
import qualified Data.Text.IO as TextIO
|
||||
import Data.Traversable (for)
|
||||
import Data.Word (Word64)
|
||||
import Database.SQLite.Simple (Connection)
|
||||
import qualified Database.SQLite.Simple as Sqlite
|
||||
import GHC.Stack (HasCallStack)
|
||||
import qualified System.Console.ANSI as ANSI
|
||||
@ -44,6 +49,9 @@ import qualified System.FilePath as FilePath
|
||||
import U.Codebase.HashTags (CausalHash (CausalHash, unCausalHash))
|
||||
import U.Codebase.Sqlite.Operations (EDB)
|
||||
import qualified U.Codebase.Reference as C.Reference
|
||||
import U.Codebase.Sqlite.Connection (Connection (Connection))
|
||||
import qualified U.Codebase.Sqlite.Connection as Connection
|
||||
import qualified U.Codebase.Sqlite.JournalMode as JournalMode
|
||||
import qualified U.Codebase.Sqlite.ObjectType as OT
|
||||
import qualified U.Codebase.Sqlite.Operations as Ops
|
||||
import qualified U.Codebase.Sqlite.Queries as Q
|
||||
@ -115,9 +123,10 @@ init = Codebase.Init getCodebaseOrError createCodebaseOrError v2dir
|
||||
|
||||
createCodebaseOrError ::
|
||||
(MonadIO m, MonadCatch m) =>
|
||||
Codebase.DebugName ->
|
||||
CodebasePath ->
|
||||
m (Either Codebase1.CreateCodebaseError (m (), Codebase m Symbol Ann))
|
||||
createCodebaseOrError dir = do
|
||||
createCodebaseOrError debugName dir = do
|
||||
prettyDir <- P.string <$> canonicalizePath dir
|
||||
let convertError = \case
|
||||
CreateCodebaseAlreadyExists -> Codebase1.CreateCodebaseAlreadyExists
|
||||
@ -125,7 +134,7 @@ createCodebaseOrError dir = do
|
||||
prettyError :: SchemaVersion -> Codebase1.Pretty
|
||||
prettyError v = P.wrap $
|
||||
"I don't know how to handle " <> P.shown v <> "in" <> P.backticked' prettyDir "."
|
||||
Either.mapLeft convertError <$> createCodebaseOrError' dir
|
||||
Either.mapLeft convertError <$> createCodebaseOrError' debugName dir
|
||||
|
||||
data CreateCodebaseError
|
||||
= CreateCodebaseAlreadyExists
|
||||
@ -134,9 +143,10 @@ data CreateCodebaseError
|
||||
|
||||
createCodebaseOrError' ::
|
||||
(MonadIO m, MonadCatch m) =>
|
||||
Codebase.DebugName ->
|
||||
CodebasePath ->
|
||||
m (Either CreateCodebaseError (m (), Codebase m Symbol Ann))
|
||||
createCodebaseOrError' path = do
|
||||
createCodebaseOrError' debugName path = do
|
||||
ifM
|
||||
(doesFileExist $ path </> codebasePath)
|
||||
(pure $ Left CreateCodebaseAlreadyExists)
|
||||
@ -144,8 +154,8 @@ createCodebaseOrError' path = do
|
||||
createDirectoryIfMissing True (path </> FilePath.takeDirectory codebasePath)
|
||||
liftIO $
|
||||
Control.Exception.bracket
|
||||
(unsafeGetConnection path)
|
||||
Sqlite.close
|
||||
(unsafeGetConnection (debugName ++ ".createSchema") path)
|
||||
shutdownConnection
|
||||
(runReaderT do
|
||||
Q.createSchema
|
||||
runExceptT (void . Ops.saveRootBranch $ Cv.causalbranch1to2 Branch.empty) >>= \case
|
||||
@ -153,26 +163,25 @@ createCodebaseOrError' path = do
|
||||
Right () -> pure ()
|
||||
)
|
||||
|
||||
fmap (Either.mapLeft CreateCodebaseUnknownSchemaVersion) (sqliteCodebase path)
|
||||
fmap (Either.mapLeft CreateCodebaseUnknownSchemaVersion) (sqliteCodebase debugName path)
|
||||
|
||||
openOrCreateCodebaseConnection :: MonadIO m => FilePath -> m Connection
|
||||
openOrCreateCodebaseConnection path = do
|
||||
openOrCreateCodebaseConnection :: MonadIO m => Codebase.DebugName -> FilePath -> m Connection
|
||||
openOrCreateCodebaseConnection debugName path = do
|
||||
unlessM
|
||||
(doesFileExist $ path </> codebasePath)
|
||||
(initSchemaIfNotExist path)
|
||||
unsafeGetConnection path
|
||||
|
||||
unsafeGetConnection debugName path
|
||||
|
||||
-- get the codebase in dir
|
||||
getCodebaseOrError :: forall m. (MonadIO m, MonadCatch m) => CodebasePath -> m (Either Codebase1.Pretty (m (), Codebase m Symbol Ann))
|
||||
getCodebaseOrError dir = do
|
||||
getCodebaseOrError :: forall m. (MonadIO m, MonadCatch m) => Codebase.DebugName -> CodebasePath -> m (Either Codebase1.Pretty (m (), Codebase m Symbol Ann))
|
||||
getCodebaseOrError debugName dir = do
|
||||
prettyDir <- liftIO $ P.string <$> canonicalizePath dir
|
||||
let prettyError v = P.wrap $ "I don't know how to handle " <> P.shown v <> "in" <> P.backticked' prettyDir "."
|
||||
doesFileExist (dir </> codebasePath) >>= \case
|
||||
-- If the codebase file doesn't exist, just return any string. The string is currently ignored (see
|
||||
-- Unison.Codebase.Init.getCodebaseOrExit).
|
||||
False -> pure (Left "codebase doesn't exist")
|
||||
True -> fmap (Either.mapLeft prettyError) (sqliteCodebase dir)
|
||||
True -> fmap (Either.mapLeft prettyError) (sqliteCodebase debugName dir)
|
||||
|
||||
initSchemaIfNotExist :: MonadIO m => FilePath -> m ()
|
||||
initSchemaIfNotExist path = liftIO do
|
||||
@ -180,8 +189,8 @@ initSchemaIfNotExist path = liftIO do
|
||||
createDirectoryIfMissing True (path </> FilePath.takeDirectory codebasePath)
|
||||
unlessM (doesFileExist $ path </> codebasePath) $
|
||||
Control.Exception.bracket
|
||||
(unsafeGetConnection path)
|
||||
Sqlite.close
|
||||
(unsafeGetConnection "initSchemaIfNotExist" path)
|
||||
shutdownConnection
|
||||
(runReaderT Q.createSchema)
|
||||
|
||||
-- checks if a db exists at `path` with the minimum schema
|
||||
@ -189,9 +198,9 @@ codebaseExists :: MonadIO m => CodebasePath -> m Bool
|
||||
codebaseExists root = liftIO do
|
||||
Monad.when debug $ traceM $ "codebaseExists " ++ root
|
||||
Control.Exception.catch @Sqlite.SQLError
|
||||
( sqliteCodebase root >>= \case
|
||||
( sqliteCodebase "codebaseExists" root >>= \case
|
||||
Left _ -> pure False
|
||||
Right (close, _codebase) -> close >> pure True
|
||||
Right (close, _codebase) -> close $> True
|
||||
)
|
||||
(const $ pure False)
|
||||
|
||||
@ -244,17 +253,23 @@ type TermBufferEntry = BufferEntry (Term Symbol Ann, Type Symbol Ann)
|
||||
|
||||
type DeclBufferEntry = BufferEntry (Decl Symbol Ann)
|
||||
|
||||
unsafeGetConnection :: MonadIO m => CodebasePath -> m Sqlite.Connection
|
||||
unsafeGetConnection root = do
|
||||
Monad.when debug $ traceM $ "unsafeGetconnection " ++ root ++ " -> " ++ (root </> codebasePath)
|
||||
conn <- liftIO . Sqlite.open $ root </> codebasePath
|
||||
unsafeGetConnection :: MonadIO m => Codebase.DebugName -> CodebasePath -> m Connection
|
||||
unsafeGetConnection name root = do
|
||||
let path = root </> codebasePath
|
||||
Monad.when debug $ traceM $ "unsafeGetconnection " ++ name ++ " " ++ root ++ " -> " ++ path
|
||||
(Connection name path -> conn) <- liftIO $ Sqlite.open path
|
||||
runReaderT Q.setFlags conn
|
||||
pure conn
|
||||
|
||||
sqliteCodebase :: (MonadIO m, MonadCatch m) => CodebasePath -> m (Either SchemaVersion (m (), Codebase m Symbol Ann))
|
||||
sqliteCodebase root = do
|
||||
Monad.when debug $ traceM $ "sqliteCodebase " ++ root
|
||||
conn <- unsafeGetConnection root
|
||||
shutdownConnection :: MonadIO m => Connection -> m ()
|
||||
shutdownConnection conn = do
|
||||
Monad.when debug $ traceM $ "shutdown connection " ++ show conn
|
||||
liftIO $ Sqlite.close (Connection.underlying conn)
|
||||
|
||||
sqliteCodebase :: (MonadIO m, MonadCatch m) => Codebase.DebugName -> CodebasePath -> m (Either SchemaVersion (m (), Codebase m Symbol Ann))
|
||||
sqliteCodebase debugName root = do
|
||||
Monad.when debug $ traceM $ "sqliteCodebase " ++ debugName ++ " " ++ root
|
||||
conn <- unsafeGetConnection debugName root
|
||||
termCache <- Cache.semispaceCache 8192 -- pure Cache.nullCache -- to disable
|
||||
typeOfTermCache <- Cache.semispaceCache 8192
|
||||
declCache <- Cache.semispaceCache 1024
|
||||
@ -572,14 +587,14 @@ sqliteCodebase root = do
|
||||
syncFromDirectory :: MonadIO m => Codebase1.CodebasePath -> SyncMode -> Branch m -> m ()
|
||||
syncFromDirectory srcRoot _syncMode b =
|
||||
flip State.evalStateT emptySyncProgressState $ do
|
||||
srcConn <- unsafeGetConnection srcRoot
|
||||
srcConn <- unsafeGetConnection (debugName ++ ".sync.src") srcRoot
|
||||
syncInternal syncProgress srcConn conn $ Branch.transform lift b
|
||||
|
||||
syncToDirectory :: MonadIO m => Codebase1.CodebasePath -> SyncMode -> Branch m -> m ()
|
||||
syncToDirectory destRoot _syncMode b =
|
||||
flip State.evalStateT emptySyncProgressState $ do
|
||||
initSchemaIfNotExist destRoot
|
||||
destConn <- unsafeGetConnection destRoot
|
||||
destConn <- unsafeGetConnection (debugName ++ ".sync.dest") destRoot
|
||||
syncInternal syncProgress conn destConn $ Branch.transform lift b
|
||||
|
||||
watches :: MonadIO m => UF.WatchKind -> m [Reference.Id]
|
||||
@ -697,12 +712,13 @@ sqliteCodebase root = do
|
||||
. (fmap . fmap) Cv.causalHash2to1
|
||||
$ Ops.lca (Cv.causalHash1to2 h1) (Cv.causalHash1to2 h2) c1 c2
|
||||
where
|
||||
open = (,) <$> unsafeGetConnection root <*> unsafeGetConnection root
|
||||
close (c1, c2) = Sqlite.close c1 *> Sqlite.close c2
|
||||
open = (,) <$> unsafeGetConnection (debugName ++ ".lca.left") root
|
||||
<*> unsafeGetConnection (debugName ++ ".lca.left") root
|
||||
close (c1, c2) = shutdownConnection c1 *> shutdownConnection c2
|
||||
|
||||
let finalizer :: MonadIO m => m ()
|
||||
finalizer = do
|
||||
liftIO $ Sqlite.close conn
|
||||
shutdownConnection conn
|
||||
decls <- readTVarIO declBuffer
|
||||
terms <- readTVarIO termBuffer
|
||||
let printBuffer header b =
|
||||
@ -753,7 +769,7 @@ sqliteCodebase root = do
|
||||
(Just \l r -> runDB conn $ fromJust <$> before l r)
|
||||
in code
|
||||
)
|
||||
v -> liftIO $ Sqlite.close conn $> Left v
|
||||
v -> shutdownConnection conn $> Left v
|
||||
|
||||
-- well one or the other. :zany_face: the thinking being that they wouldn't hash-collide
|
||||
termExists', declExists' :: MonadIO m => Hash -> ReaderT Connection (ExceptT Ops.Error m) Bool
|
||||
@ -836,17 +852,19 @@ syncInternal progress srcConn destConn b = time "syncInternal" do
|
||||
traceM $ " decls: " ++ show ds
|
||||
traceM $ " edits: " ++ show es
|
||||
(cs, es, ts, ds) <- lift $ runDB destConn do
|
||||
cs <- filterM (fmap not . runDB destConn . isCausalHash' . fst) branchDeps
|
||||
es <- filterM (fmap not . runDB destConn . patchExists') es
|
||||
ts <- filterM (fmap not . runDB destConn . termExists') ts
|
||||
ds <- filterM (fmap not . runDB destConn . declExists') ds
|
||||
cs <- filterM (fmap not . isCausalHash' . fst) branchDeps
|
||||
es <- filterM (fmap not . patchExists') es
|
||||
ts <- filterM (fmap not . termExists') ts
|
||||
ds <- filterM (fmap not . declExists') ds
|
||||
pure (cs, es, ts, ds)
|
||||
if null cs && null es && null ts && null ds
|
||||
then lift . runDB destConn $ putBranch' b
|
||||
else
|
||||
let bs = map (uncurry B) branchDeps
|
||||
then do
|
||||
lift . runDB destConn $ putBranch' b
|
||||
processBranches @m sync progress rest
|
||||
else do
|
||||
let bs = map (uncurry B) cs
|
||||
os = map O (es <> ts <> ds)
|
||||
in processBranches @m sync progress (os ++ bs ++ B h mb : rest)
|
||||
processBranches @m sync progress (os ++ bs ++ b0 : rest)
|
||||
processBranches sync progress (O h : rest) = do
|
||||
when debugProcessBranches $ traceM $ "processBranches O " ++ take 10 (show h)
|
||||
(runExceptT $ flip runReaderT srcConn (Q.expectHashIdByHash (Cv.hash1to2 h) >>= Q.expectObjectIdForAnyHashId)) >>= \case
|
||||
@ -978,7 +996,7 @@ viewRemoteBranch' (repo, sbh, path) = runExceptT do
|
||||
ifM
|
||||
(codebaseExists remotePath)
|
||||
do
|
||||
lift (sqliteCodebase remotePath) >>= \case
|
||||
lift (sqliteCodebase "viewRemoteBranch.gitCache" remotePath) >>= \case
|
||||
Left sv -> ExceptT . pure . Left $ GitError.UnrecognizedSchemaVersion repo remotePath sv
|
||||
Right (closeCodebase, codebase) -> do
|
||||
-- try to load the requested branch from it
|
||||
@ -1027,7 +1045,7 @@ pushGitRootBranch srcConn branch repo = runExceptT @GitError do
|
||||
|
||||
-- set up the cache dir
|
||||
remotePath <- time "Git fetch" $ pullBranch repo
|
||||
destConn <- openOrCreateCodebaseConnection remotePath
|
||||
destConn <- openOrCreateCodebaseConnection "push.dest" remotePath
|
||||
|
||||
flip runReaderT destConn $ Q.savepoint "push"
|
||||
lift . flip State.execStateT emptySyncProgressState $
|
||||
@ -1057,10 +1075,11 @@ pushGitRootBranch srcConn branch repo = runExceptT @GitError do
|
||||
setRepoRoot newRootHash
|
||||
Q.release "push"
|
||||
|
||||
liftIO do
|
||||
Sqlite.close destConn
|
||||
void $ push remotePath repo
|
||||
Q.setJournalMode JournalMode.DELETE
|
||||
|
||||
liftIO do
|
||||
shutdownConnection destConn
|
||||
void $ push remotePath repo
|
||||
where
|
||||
repoString = Text.unpack $ printRepo repo
|
||||
setRepoRoot :: Q.DB m => Branch.Hash -> m ()
|
||||
@ -1070,15 +1089,68 @@ pushGitRootBranch srcConn branch repo = runExceptT @GitError do
|
||||
chId <- fromMaybe err <$> Q.loadCausalHashIdByCausalHash h2
|
||||
Q.setNamespaceRoot chId
|
||||
|
||||
-- This function makes sure that the result of git status is valid.
|
||||
-- Valid lines are any of:
|
||||
--
|
||||
-- ?? .unison/v2/unison.sqlite3 (initial commit to an empty repo)
|
||||
-- M .unison/v2/unison.sqlite3 (updating an existing repo)
|
||||
-- D .unison/v2/unison.sqlite3-wal (cleaning up the WAL from before bugfix)
|
||||
-- D .unison/v2/unison.sqlite3-shm (ditto)
|
||||
--
|
||||
-- Invalid lines are like:
|
||||
--
|
||||
-- ?? .unison/v2/unison.sqlite3-wal
|
||||
--
|
||||
-- Which will only happen if the write-ahead log hasn't been
|
||||
-- fully folded into the unison.sqlite3 file.
|
||||
--
|
||||
-- Returns `Just (hasDeleteWal, hasDeleteShm)` on success,
|
||||
-- `Nothing` otherwise. hasDeleteWal means there's the line:
|
||||
-- D .unison/v2/unison.sqlite3-wal
|
||||
-- and hasDeleteShm is `True` if there's the line:
|
||||
-- D .unison/v2/unison.sqlite3-shm
|
||||
--
|
||||
parseStatus :: Text -> Maybe (Bool, Bool)
|
||||
parseStatus status =
|
||||
if all okLine statusLines then Just (hasDeleteWal, hasDeleteShm)
|
||||
else Nothing
|
||||
where
|
||||
statusLines = Text.unpack <$> Text.lines status
|
||||
t = dropWhile Char.isSpace
|
||||
okLine (t -> '?' : '?' : (t -> p)) | p == codebasePath = True
|
||||
okLine (t -> 'M' : (t -> p)) | p == codebasePath = True
|
||||
okLine line = isWalDelete line || isShmDelete line
|
||||
isWalDelete (t -> 'D' : (t -> p)) | p == codebasePath ++ "-wal" = True
|
||||
isWalDelete _ = False
|
||||
isShmDelete (t -> 'D' : (t -> p)) | p == codebasePath ++ "-wal" = True
|
||||
isShmDelete _ = False
|
||||
hasDeleteWal = any isWalDelete statusLines
|
||||
hasDeleteShm = any isShmDelete statusLines
|
||||
|
||||
-- Commit our changes
|
||||
push :: CodebasePath -> RemoteRepo -> IO Bool -- withIOError needs IO
|
||||
push remotePath (GitRepo url gitbranch) = time "SqliteCodebase.pushGitRootBranch.push" $ do
|
||||
-- has anything changed?
|
||||
status <- gitTextIn remotePath ["status", "--short"]
|
||||
-- note: -uall recursively shows status for all files in untracked directories
|
||||
-- we want this so that we see
|
||||
-- `?? .unison/v2/unison.sqlite3` and not
|
||||
-- `?? .unison/`
|
||||
status <- gitTextIn remotePath ["status", "--short", "-uall"]
|
||||
if Text.null status
|
||||
then pure False
|
||||
else do
|
||||
gitIn remotePath ["add", "--all", "."]
|
||||
else case parseStatus status of
|
||||
Nothing ->
|
||||
error $ "An error occurred during push.\n"
|
||||
<> "I was expecting only to see .unison/v2/unison.sqlite3 modified, but saw:\n\n"
|
||||
<> Text.unpack status <> "\n\n"
|
||||
<> "Please visit https://github.com/unisonweb/unison/issues/2063\n"
|
||||
<> "and add any more details about how you encountered this!\n"
|
||||
Just (hasDeleteWal, hasDeleteShm) -> do
|
||||
-- Only stage files we're expecting; don't `git add --all .`
|
||||
-- which could accidentally commit some garbage
|
||||
gitIn remotePath ["add", ".unison/v2/unison.sqlite3"]
|
||||
when hasDeleteWal $ gitIn remotePath ["rm", ".unison/v2/unison.sqlite3-wal"]
|
||||
when hasDeleteShm $ gitIn remotePath ["rm", ".unison/v2/unison.sqlite3-shm"]
|
||||
gitIn
|
||||
remotePath
|
||||
["commit", "-q", "-m", "Sync branch " <> Text.pack (show $ Branch.headHash branch)]
|
||||
|
@ -122,6 +122,8 @@ data DocLiteralContext
|
||||
|
||||
>=10
|
||||
10f 10x 10y ...
|
||||
termLink t
|
||||
typeLink t
|
||||
|
||||
>=3
|
||||
x -> 2y
|
||||
@ -177,11 +179,13 @@ pretty0
|
||||
where name = elideFQN im $ HQ.unsafeFromVar (Var.reset v)
|
||||
Ref' r -> parenIfInfix name ic $ styleHashQualified'' (fmt $ S.Reference r) name
|
||||
where name = elideFQN im $ PrettyPrintEnv.termName n (Referent.Ref r)
|
||||
TermLink' r -> parenIfInfix name ic $
|
||||
fmt S.LinkKeyword "termLink " <> styleHashQualified'' (fmt $ S.Referent r) name
|
||||
TermLink' r -> paren (p >= 10) $
|
||||
fmt S.LinkKeyword "termLink " <>
|
||||
(parenIfInfix name ic $ styleHashQualified'' (fmt $ S.Referent r) name)
|
||||
where name = elideFQN im $ PrettyPrintEnv.termName n r
|
||||
TypeLink' r -> parenIfInfix name ic $
|
||||
fmt S.LinkKeyword "typeLink " <> styleHashQualified'' (fmt $ S.Reference r) name
|
||||
TypeLink' r -> paren (p >= 10) $
|
||||
fmt S.LinkKeyword "typeLink " <>
|
||||
(parenIfInfix name ic $ styleHashQualified'' (fmt $ S.Reference r) name)
|
||||
where name = elideFQN im $ PrettyPrintEnv.typeName n r
|
||||
Ann' tm t ->
|
||||
paren (p >= 0)
|
||||
|
@ -1,5 +1,6 @@
|
||||
module Unison.Util.Less where
|
||||
|
||||
import System.Environment (lookupEnv)
|
||||
import System.Process
|
||||
import System.IO (hPutStr, hClose)
|
||||
import Control.Exception.Extra (ignore)
|
||||
@ -7,6 +8,10 @@ import Unison.Prelude (void)
|
||||
|
||||
less :: String -> IO ()
|
||||
less str = do
|
||||
inEmacs <- lookupEnv "INSIDE_EMACS"
|
||||
case inEmacs of
|
||||
Just _ -> putStr str
|
||||
Nothing -> do
|
||||
let args = ["--no-init" -- don't clear the screen on exit
|
||||
,"--raw-control-chars" -- pass through colors and stuff
|
||||
,"--prompt=[less] Use space/arrow keys to navigate, or 'q' to return to ucm:"
|
||||
|
@ -363,6 +363,51 @@ test = scope "gitsync22" . tests $
|
||||
void . fmap (fromJust . sequence) $
|
||||
traverse (Codebase.getWatch cb TestWatch) =<<
|
||||
Codebase.watches cb TestWatch)
|
||||
,
|
||||
pushPullTest "fix2068(a)" fmt
|
||||
-- this triggers
|
||||
{-
|
||||
gitsync22.sc.fix2068(a) EXCEPTION!!!: Called SqliteCodebase.setNamespaceRoot on unknown causal hash CausalHash (fromBase32Hex "codddvgt1ep57qpdkhe2j4pe1ehlpi5iitcrludtb8ves1aaqjl453onvfphqg83vukl7bbrj49itceqfob2b3alf47u4vves5s7pog")
|
||||
CallStack (from HasCallStack):
|
||||
error, called at src/Unison/Codebase/SqliteCodebase.hs:1072:17 in unison-parser-typechecker-0.0.0-6U6boimwb8GAC5qrhLfs8h:Unison.Codebase.SqliteCodebase
|
||||
-}
|
||||
(\repo -> [i|
|
||||
```ucm
|
||||
.> alias.type ##Nat builtin.Nat2
|
||||
.> alias.type ##Int builtin.Int2
|
||||
.> push ${repo}:.foo.bar
|
||||
```
|
||||
|])
|
||||
(\repo -> [i|
|
||||
```ucm
|
||||
.> pull ${repo} pulled
|
||||
.> view pulled.foo.bar.builtin.Nat2
|
||||
.> view pulled.foo.bar.builtin.Int2
|
||||
```
|
||||
|])
|
||||
,
|
||||
pushPullTest "fix2068(b)" fmt
|
||||
-- this triggers
|
||||
{-
|
||||
- gitsync22.sc.fix2068(b) EXCEPTION!!!: I couldn't find the hash ndn6fa85ggqtbgffqhd4d3bca2d08pgp3im36oa8k6p257aid90ovjq75htmh7lmg7akaqneva80ml1o21iscjmp9n1uc3lmqgg9rgg that I just synced to the cached copy of /private/var/folders/6m/p3szds2j67d8vwmxr51yrf5c0000gn/T/git-simple-1047398c149d3d5c/repo.git in "/Users/pchiusano/.cache/unisonlanguage/gitfiles/$x2F$private$x2F$var$x2F$folders$x2F$6m$x2F$p3szds2j67d8vwmxr51yrf5c0000gn$x2F$T$x2F$git-simple-1047398c149d3d5c$x2F$repo$dot$git".
|
||||
CallStack (from HasCallStack):
|
||||
error, called at src/Unison/Codebase/SqliteCodebase.hs:1046:13 in unison-parser-typechecker-0.0.0-6U6boimwb8GAC5qrhLfs8h:Unison.Codebase.SqliteCodebase
|
||||
-}
|
||||
(\repo -> [i|
|
||||
```ucm
|
||||
.> alias.type ##Nat builtin.Nat2
|
||||
.> alias.type ##Int builtin.Int2
|
||||
.> push ${repo}
|
||||
.> push ${repo}:.foo.bar
|
||||
```
|
||||
|])
|
||||
(\repo -> [i|
|
||||
```ucm
|
||||
.> pull ${repo} pulled
|
||||
.> view pulled.foo.bar.builtin.Nat2
|
||||
.> view pulled.foo.bar.builtin.Int2
|
||||
```
|
||||
|])
|
||||
|
||||
-- m [Reference.Id]
|
||||
|
||||
|
@ -53,8 +53,8 @@ initCodebase fmt = do
|
||||
let cbInit = case fmt of CodebaseFormat1 -> FC.init; CodebaseFormat2 -> SC.init
|
||||
tmp <-
|
||||
Temp.getCanonicalTemporaryDirectory
|
||||
>>= flip Temp.createTempDirectory ("ucm-test")
|
||||
Codebase.Init.createCodebase cbInit tmp >>= \case
|
||||
>>= flip Temp.createTempDirectory "ucm-test"
|
||||
Codebase.Init.createCodebase cbInit "ucm-test" tmp >>= \case
|
||||
Left e -> fail $ P.toANSI 80 e
|
||||
Right (close, _cb) -> close
|
||||
pure $ Codebase tmp fmt
|
||||
@ -80,7 +80,7 @@ runTranscript (Codebase codebasePath fmt) transcript = do
|
||||
let err err = fail $ "Parse error: \n" <> show err
|
||||
cbInit = case fmt of CodebaseFormat1 -> FC.init; CodebaseFormat2 -> SC.init
|
||||
(closeCodebase, codebase) <-
|
||||
Codebase.Init.openCodebase cbInit codebasePath >>= \case
|
||||
Codebase.Init.openCodebase cbInit "transcript" codebasePath >>= \case
|
||||
Left e -> fail $ P.toANSI 80 e
|
||||
Right x -> pure x
|
||||
Codebase.installUcmDependencies codebase
|
||||
@ -100,6 +100,6 @@ runTranscript (Codebase codebasePath fmt) transcript = do
|
||||
lowLevel :: Codebase -> (Codebase.Codebase IO Symbol Ann -> IO a) -> IO a
|
||||
lowLevel (Codebase root fmt) f = do
|
||||
let cbInit = case fmt of CodebaseFormat1 -> FC.init; CodebaseFormat2 -> SC.init
|
||||
Codebase.Init.openCodebase cbInit root >>= \case
|
||||
Codebase.Init.openCodebase cbInit "lowLevel" root >>= \case
|
||||
Left p -> PT.putPrettyLn p *> pure (error "This really should have loaded")
|
||||
Right (close, cb) -> f cb <* close
|
||||
|
@ -19,7 +19,7 @@ source-repository head
|
||||
|
||||
flag optimized
|
||||
manual: True
|
||||
default: False
|
||||
default: True
|
||||
|
||||
library
|
||||
exposed-modules:
|
||||
|
@ -22,7 +22,7 @@ import Data.Configurator.Types (Config)
|
||||
import qualified Data.Text as Text
|
||||
import qualified GHC.Conc
|
||||
import qualified Network.URI.Encode as URI
|
||||
import System.Directory (getCurrentDirectory, removeDirectoryRecursive)
|
||||
import System.Directory (canonicalizePath, getCurrentDirectory, removeDirectoryRecursive)
|
||||
import System.Environment (getArgs, getProgName)
|
||||
import qualified System.Exit as Exit
|
||||
import qualified System.FilePath as FP
|
||||
@ -62,7 +62,10 @@ usage executableStr = P.callout "🌻" $ P.lines [
|
||||
P.wrap "Starts Unison interactively, using the codebase in the home directory.",
|
||||
"",
|
||||
P.bold $ executable <> " -codebase path/to/codebase",
|
||||
P.wrap "Starts Unison interactively, using the specified codebase. This flag can also be set for any of the below commands.",
|
||||
P.wrap "Starts Unison interactively, using the specified codebase. This flag can also be set before any of the below commands.",
|
||||
"",
|
||||
P.bold $ executable <> " --old-codebase",
|
||||
P.wrap $ "Starts Unison using a v1 codebase. This flag can also be set before any of the below commands.",
|
||||
"",
|
||||
P.bold $ executable <> " run .mylib.mymain",
|
||||
P.wrap "Executes the definition `.mylib.mymain` from the codebase, then exits.",
|
||||
@ -100,6 +103,9 @@ usage executableStr = P.callout "🌻" $ P.lines [
|
||||
<> "Multiple transcript files may be provided; they are processed in sequence"
|
||||
<> "starting from the same codebase.",
|
||||
"",
|
||||
P.bold $ executable <> " upgrade-codebase",
|
||||
"Upgrades a v1 codebase to a v2 codebase.",
|
||||
"",
|
||||
P.bold $ executable <> " headless",
|
||||
"Runs the codebase server without the command-line interface.",
|
||||
"",
|
||||
@ -133,6 +139,12 @@ installSignalHandlers = do
|
||||
|
||||
return ()
|
||||
|
||||
|
||||
data CodebaseFormat = V1 | V2 deriving (Eq)
|
||||
|
||||
cbInitFor :: CodebaseFormat -> Codebase.Init IO Symbol Ann
|
||||
cbInitFor = \case V1 -> FC.init; V2 -> SC.init
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
args <- getArgs
|
||||
@ -147,11 +159,11 @@ main = do
|
||||
let (mcodepath, restargs0) = case args of
|
||||
"-codebase" : codepath : restargs -> (Just codepath, restargs)
|
||||
_ -> (Nothing, args)
|
||||
(fromMaybe True -> newCodebase, restargs) = case restargs0 of
|
||||
"--new-codebase" : rest -> (Just True, rest)
|
||||
"--old-codebase" : rest -> (Just False, rest)
|
||||
(fromMaybe V2 -> cbFormat, restargs) = case restargs0 of
|
||||
"--new-codebase" : rest -> (Just V2, rest)
|
||||
"--old-codebase" : rest -> (Just V1, rest)
|
||||
_ -> (Nothing, restargs0)
|
||||
cbInit = if newCodebase then SC.init else FC.init
|
||||
cbInit = case cbFormat of V1 -> FC.init; V2 -> SC.init
|
||||
currentDir <- getCurrentDirectory
|
||||
configFilePath <- getConfigFilePath mcodepath
|
||||
config <-
|
||||
@ -161,9 +173,9 @@ main = do
|
||||
[version] | isFlag "version" version ->
|
||||
putStrLn $ progName ++ " version: " ++ Version.gitDescribe
|
||||
[help] | isFlag "help" help -> PT.putPrettyLn (usage progName)
|
||||
["init"] -> Codebase.initCodebaseAndExit cbInit mcodepath
|
||||
["init"] -> Codebase.initCodebaseAndExit cbInit "main.init" mcodepath
|
||||
"run" : [mainName] -> do
|
||||
(closeCodebase, theCodebase) <- Codebase.getCodebaseOrExit cbInit mcodepath
|
||||
(closeCodebase, theCodebase) <- getCodebaseOrExit cbFormat mcodepath
|
||||
runtime <- RTI.startRuntime
|
||||
execute theCodebase runtime mainName
|
||||
closeCodebase
|
||||
@ -172,7 +184,7 @@ main = do
|
||||
case e of
|
||||
Left _ -> PT.putPrettyLn $ P.callout "⚠️" "I couldn't find that file or it is for some reason unreadable."
|
||||
Right contents -> do
|
||||
(closeCodebase, theCodebase) <- Codebase.getCodebaseOrExit cbInit mcodepath
|
||||
(closeCodebase, theCodebase) <- getCodebaseOrExit cbFormat mcodepath
|
||||
let fileEvent = Input.UnisonFileChanged (Text.pack file) contents
|
||||
launch currentDir config theCodebase [Left fileEvent, Right $ Input.ExecuteI mainName, Right Input.QuitI]
|
||||
closeCodebase
|
||||
@ -181,7 +193,7 @@ main = do
|
||||
case e of
|
||||
Left _ -> PT.putPrettyLn $ P.callout "⚠️" "I had trouble reading this input."
|
||||
Right contents -> do
|
||||
(closeCodebase, theCodebase) <- Codebase.getCodebaseOrExit cbInit mcodepath
|
||||
(closeCodebase, theCodebase) <- getCodebaseOrExit cbFormat mcodepath
|
||||
let fileEvent = Input.UnisonFileChanged (Text.pack "<standard input>") contents
|
||||
launch
|
||||
currentDir config theCodebase
|
||||
@ -189,16 +201,16 @@ main = do
|
||||
closeCodebase
|
||||
"transcript" : args' ->
|
||||
case args' of
|
||||
"-save-codebase" : transcripts -> runTranscripts cbInit False True mcodepath transcripts
|
||||
_ -> runTranscripts cbInit False False mcodepath args'
|
||||
"-save-codebase" : transcripts -> runTranscripts cbFormat False True mcodepath transcripts
|
||||
_ -> runTranscripts cbFormat False False mcodepath args'
|
||||
"transcript.fork" : args' ->
|
||||
case args' of
|
||||
"-save-codebase" : transcripts -> runTranscripts cbInit True True mcodepath transcripts
|
||||
_ -> runTranscripts cbInit True False mcodepath args'
|
||||
"-save-codebase" : transcripts -> runTranscripts cbFormat True True mcodepath transcripts
|
||||
_ -> runTranscripts cbFormat True False mcodepath args'
|
||||
["upgrade-codebase"] -> upgradeCodebase mcodepath
|
||||
args -> do
|
||||
let headless = listToMaybe args == Just "headless"
|
||||
(closeCodebase, theCodebase) <- Codebase.getCodebaseOrExit cbInit mcodepath
|
||||
(closeCodebase, theCodebase) <- getCodebaseOrExit cbFormat mcodepath
|
||||
Server.start theCodebase $ \token port -> do
|
||||
let url =
|
||||
"http://127.0.0.1:" <> show port <> "/" <> URI.encode (unpack token)
|
||||
@ -237,12 +249,12 @@ upgradeCodebase mcodepath =
|
||||
<> "but there's no rush. You can access the old codebase again by passing the"
|
||||
<> P.backticked "--old-codebase" <> "flag at startup."
|
||||
|
||||
prepareTranscriptDir :: Codebase.Init IO Symbol Ann -> Bool -> Maybe FilePath -> IO FilePath
|
||||
prepareTranscriptDir cbInit inFork mcodepath = do
|
||||
prepareTranscriptDir :: CodebaseFormat -> Bool -> Maybe FilePath -> IO FilePath
|
||||
prepareTranscriptDir cbFormat inFork mcodepath = do
|
||||
tmp <- Temp.getCanonicalTemporaryDirectory >>= (`Temp.createTempDirectory` "transcript")
|
||||
|
||||
let cbInit = cbInitFor cbFormat
|
||||
if inFork then
|
||||
Codebase.getCodebaseOrExit cbInit mcodepath >> do
|
||||
getCodebaseOrExit cbFormat mcodepath >> do
|
||||
path <- Codebase.getCodebaseDir mcodepath
|
||||
PT.putPrettyLn $ P.lines [
|
||||
P.wrap "Transcript will be run on a copy of the codebase at: ", "",
|
||||
@ -251,16 +263,16 @@ prepareTranscriptDir cbInit inFork mcodepath = do
|
||||
Path.copyDir (Codebase.codebasePath cbInit path) (Codebase.codebasePath cbInit tmp)
|
||||
else do
|
||||
PT.putPrettyLn . P.wrap $ "Transcript will be run on a new, empty codebase."
|
||||
void $ Codebase.openNewUcmCodebaseOrExit cbInit tmp
|
||||
void $ Codebase.openNewUcmCodebaseOrExit cbInit "main.transcript" tmp
|
||||
pure tmp
|
||||
|
||||
runTranscripts'
|
||||
:: Codebase.Init IO Symbol Ann
|
||||
:: CodebaseFormat
|
||||
-> Maybe FilePath
|
||||
-> FilePath
|
||||
-> [String]
|
||||
-> IO Bool
|
||||
runTranscripts' cbInit mcodepath transcriptDir args = do
|
||||
runTranscripts' codebaseFormat mcodepath transcriptDir args = do
|
||||
currentDir <- getCurrentDirectory
|
||||
case args of
|
||||
args@(_:_) -> do
|
||||
@ -275,7 +287,7 @@ runTranscripts' cbInit mcodepath transcriptDir args = do
|
||||
P.indentN 2 $ P.string err])
|
||||
Right stanzas -> do
|
||||
configFilePath <- getConfigFilePath mcodepath
|
||||
(closeCodebase, theCodebase) <- Codebase.getCodebaseOrExit cbInit $ Just transcriptDir
|
||||
(closeCodebase, theCodebase) <- getCodebaseOrExit codebaseFormat $ Just transcriptDir
|
||||
mdOut <- TR.run transcriptDir configFilePath stanzas theCodebase
|
||||
closeCodebase
|
||||
let out = currentDir FP.</>
|
||||
@ -293,17 +305,17 @@ runTranscripts' cbInit mcodepath transcriptDir args = do
|
||||
pure False
|
||||
|
||||
runTranscripts
|
||||
:: Codebase.Init IO Symbol Ann
|
||||
:: CodebaseFormat
|
||||
-> Bool
|
||||
-> Bool
|
||||
-> Maybe FilePath
|
||||
-> [String]
|
||||
-> IO ()
|
||||
runTranscripts cbInit inFork keepTemp mcodepath args = do
|
||||
runTranscripts cbFormat inFork keepTemp mcodepath args = do
|
||||
progName <- getProgName
|
||||
transcriptDir <- prepareTranscriptDir cbInit inFork mcodepath
|
||||
transcriptDir <- prepareTranscriptDir cbFormat inFork mcodepath
|
||||
completed <-
|
||||
runTranscripts' cbInit (Just transcriptDir) transcriptDir args
|
||||
runTranscripts' cbFormat (Just transcriptDir) transcriptDir args
|
||||
when completed $ do
|
||||
unless keepTemp $ removeDirectoryRecursive transcriptDir
|
||||
when keepTemp $ PT.putPrettyLn $
|
||||
@ -352,3 +364,73 @@ getConfigFilePath mcodepath = (FP.</> ".unisonConfig") <$> Codebase.getCodebaseD
|
||||
defaultBaseLib :: Maybe RemoteNamespace
|
||||
defaultBaseLib = rightMay $
|
||||
runParser VP.defaultBaseLib "version" (Text.pack Version.gitDescribe)
|
||||
|
||||
-- | load an existing codebase or exit.
|
||||
getCodebaseOrExit :: CodebaseFormat -> Maybe Codebase.CodebasePath -> IO (IO (), Codebase.Codebase IO Symbol Ann)
|
||||
getCodebaseOrExit cbFormat mdir = do
|
||||
let cbInit = cbInitFor cbFormat
|
||||
dir <- Codebase.getCodebaseDir mdir
|
||||
Codebase.openCodebase cbInit "main" dir >>= \case
|
||||
Left _errRequestedVersion -> do
|
||||
let
|
||||
sayNoCodebase = noCodebaseMsg <$> prettyExe <*> prettyDir <*> pure (fmap P.string mdir)
|
||||
suggestUpgrade = suggestUpgradeMessage <$> prettyExe <*> prettyDir <*> pure (fmap P.string mdir)
|
||||
prettyExe = P.text . Text.pack <$> getProgName
|
||||
prettyDir = P.string <$> canonicalizePath dir
|
||||
PT.putPrettyLn' =<< case cbFormat of
|
||||
V1 -> sayNoCodebase
|
||||
V2 -> FC.openCodebase dir >>= \case
|
||||
Left {} -> sayNoCodebase
|
||||
Right {} -> suggestUpgrade
|
||||
Exit.exitFailure
|
||||
Right x -> pure x
|
||||
where
|
||||
noCodebaseMsg :: _
|
||||
noCodebaseMsg executable prettyDir mdir =
|
||||
let secondLine =
|
||||
case mdir of
|
||||
Just dir ->
|
||||
"Run `" <> executable <> " -codebase " <> dir
|
||||
<> " init` to create one, then try again!"
|
||||
Nothing ->
|
||||
"Run `" <> executable <> " init` to create one there,"
|
||||
<> " then try again;"
|
||||
<> " or `"
|
||||
<> executable
|
||||
<> " -codebase <dir>` to load a codebase from someplace else!"
|
||||
in P.lines
|
||||
[ "No codebase exists in " <> prettyDir <> ".",
|
||||
secondLine
|
||||
]
|
||||
suggestUpgradeMessage exec resolvedDir specifiedDir =
|
||||
P.lines
|
||||
( P.wrap
|
||||
<$> [ "I looked for a" <> prettyFmt V2 <> " codebase in " <> P.backticked' resolvedDir ","
|
||||
<> "but found only a"
|
||||
<> prettyFmt V1
|
||||
<> "codebase there.",
|
||||
"",
|
||||
"You can use:"
|
||||
]
|
||||
)
|
||||
<> P.newline
|
||||
<> P.bulleted
|
||||
( P.wrap
|
||||
<$> [ P.backticked (P.wrap $ exec <> maybe mempty ("-codebase" <>) specifiedDir <> "upgrade-codebase")
|
||||
<> "to update it to"
|
||||
<> P.group (prettyFmt V2 <> ","),
|
||||
P.backticked (P.wrap $ exec <> maybe mempty ("-codebase" <>) specifiedDir <> "init")
|
||||
<> "to create a new"
|
||||
<> prettyFmt V2
|
||||
<> "codebase alongside it, or",
|
||||
P.backticked (P.wrap $ exec <> "-codebase <dir>")
|
||||
<> "to load a"
|
||||
<> prettyFmt V2
|
||||
<> "codebase from elsewhere."
|
||||
]
|
||||
)
|
||||
|
||||
|
||||
|
||||
prettyFmt :: IsString s => CodebaseFormat -> P.Pretty s
|
||||
prettyFmt = \case V1 -> "v1"; V2 -> "v2"
|
||||
|
@ -46,4 +46,4 @@ flags:
|
||||
|
||||
when:
|
||||
- condition: flag(optimized)
|
||||
ghc-options: -funbox-strict-fields
|
||||
ghc-options: -O2 -funbox-strict-fields
|
||||
|
@ -4,7 +4,7 @@ cabal-version: 1.12
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 25e073d1bb732e90d3e1d3999ec516185669150701345da4fcd35cb20389334d
|
||||
-- hash: 6eae706c8674f4a7f22bb4bff150798cdaba8aa9186b3d94a6a8467a9cc23d06
|
||||
|
||||
name: unison-core1
|
||||
version: 0.0.0
|
||||
@ -98,5 +98,5 @@ library
|
||||
, util
|
||||
, vector
|
||||
if flag(optimized)
|
||||
ghc-options: -funbox-strict-fields
|
||||
ghc-options: -O2 -funbox-strict-fields
|
||||
default-language: Haskell2010
|
||||
|
@ -59,7 +59,7 @@ myServer = unsafeRun! '(hello "127.0.0.1" "0")
|
||||
value:
|
||||
|
||||
base.io.Failure.Failure
|
||||
typeLink base.io.IOFailure "problem" !base.Any.Any
|
||||
(typeLink base.io.IOFailure) "problem" !base.Any.Any
|
||||
|
||||
I'm sorry this message doesn't have more detail about the
|
||||
location of the failure. My makers plan to fix this in a
|
||||
|
@ -1028,7 +1028,7 @@ rendered = Pretty.get (docFormatConsole doc.guide)
|
||||
(Left
|
||||
(SpecialForm.Link
|
||||
(Left
|
||||
typeLink Optional))),
|
||||
(typeLink Optional)))),
|
||||
!Lit
|
||||
(Right (Plain "is")),
|
||||
!Lit (Right (Plain "a")),
|
||||
@ -1890,7 +1890,7 @@ rendered = Pretty.get (docFormatConsole doc.guide)
|
||||
(!Lit
|
||||
(Left
|
||||
(SpecialForm.Source
|
||||
[ (Left typeLink Optional,
|
||||
[ (Left (typeLink Optional),
|
||||
[]),
|
||||
(Right
|
||||
(Term.Term
|
||||
@ -1922,7 +1922,7 @@ rendered = Pretty.get (docFormatConsole doc.guide)
|
||||
(!Lit
|
||||
(Left
|
||||
(FoldedSource
|
||||
[ (Left typeLink Optional,
|
||||
[ (Left (typeLink Optional),
|
||||
[]),
|
||||
(Right
|
||||
(Term.Term
|
||||
|
Loading…
Reference in New Issue
Block a user