implemented create.author command

closes #1392

parser-typechecker/src/Unison/Codebase/Editor/AuthorInfo.hs

@@ -0,0 +1,60 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Unison.Codebase.Editor.AuthorInfo where
+
+import Unison.Term (Term, hashComponents)
+
+import qualified Unison.Reference as Reference
+import Unison.Prelude (MonadIO, Word8)
+import Unison.Var (Var)
+import Data.ByteString (unpack)
+import Crypto.Random (getRandomBytes)
+import qualified Data.Map as Map
+import qualified Unison.Var as Var
+import Data.Foldable (toList)
+import UnliftIO (liftIO)
+import qualified Unison.Term as Term
+import qualified Unison.Type as Type
+import Unison.Type (Type)
+import Data.Text (Text)
+
+data AuthorInfo v a = AuthorInfo
+  { guid, author, copyrightHolder :: (Reference.Id, Term v a, Type v a) }
+
+createAuthorInfo :: forall m v a. MonadIO m => Var v => a -> Text -> m (AuthorInfo v a)
+createAuthorInfo a t = createAuthorInfo' . unpack <$> liftIO (getRandomBytes 32)
+  where
+  createAuthorInfo' :: [Word8] -> AuthorInfo v a
+  createAuthorInfo' bytes = let
+    [(guidRef, guidTerm)] = hashAndWrangle "guid" $
+      Term.app a
+        (Term.constructor a guidTypeRef 0)
+        (Term.app a
+          (Term.builtin a "Bytes.fromList")
+          (Term.seq a (map (Term.nat a . fromIntegral) bytes)))
+
+    [(authorRef, authorTerm)] = hashAndWrangle "author" $
+      Term.apps
+        (Term.constructor a authorTypeRef 0)
+        [(a, Term.ref a (Reference.DerivedId guidRef))
+        ,(a, Term.text a t)]
+
+    [(chRef, chTerm)] = hashAndWrangle "copyrightHolder" $
+      Term.apps
+        (Term.constructor a chTypeRef 0)
+        [(a, Term.ref a (Reference.DerivedId guidRef))
+        ,(a, Term.text a t)]
+
+    in AuthorInfo
+        (guidRef, guidTerm, guidType)
+        (authorRef, authorTerm, authorType)
+        (chRef, chTerm, chType)
+  hashAndWrangle v tm = toList . hashComponents $ Map.fromList [(Var.named v, tm)]
+  (chType, chTypeRef) = (Type.ref a chTypeRef, unsafeParse copyrightHolderHash)
+  (authorType, authorTypeRef) = (Type.ref a authorTypeRef, unsafeParse authorHash)
+  (guidType, guidTypeRef) = (Type.ref a guidTypeRef, unsafeParse guidHash)
+  unsafeParse = either error id . Reference.fromText
+  guidHash = "#rc29vdqe019p56kupcgkg07fkib86r3oooatbmsgfbdsgpmjhsh00l307iuts3r973q5etb61vbjkes42b6adb3mkorusvmudiuorno"
+  copyrightHolderHash = "#aohndsu9bl844vspujp142j5aijv86rifmnrbnjvpv3h3f3aekn45rj5s1uf1ucrrtm5urbc5d1ajtm7lqq1tr8lkgv5fathp6arqug"
+  authorHash = "#5hi1vvs5t1gmu6vn1kpqmgksou8ie872j31gc294lgqks71di6gm3d4ugnrr4mq8ov0ap1e20lq099d5g6jjf9c6cbp361m9r9n5g50"

parser-typechecker/src/Unison/Codebase/Editor/Command.hs

@@ -39,6 +39,7 @@ import           Unison.ShortHash               ( ShortHash )
 import           Unison.Type                    ( Type )
 import           Unison.Codebase.ShortBranchHash
                                                 ( ShortBranchHash )
+import Unison.Codebase.Editor.AuthorInfo (AuthorInfo)
 
 
 type AmbientAbilities v = [Type v Ann]
@@ -187,3 +188,5 @@ data Command m i v a where
   -- Execute a UnisonFile for its IO effects
   -- todo: Execute should do some evaluation?
   Execute :: PPE.PrettyPrintEnv -> UF.TypecheckedUnisonFile v Ann -> Command m i v ()
+
+  CreateAuthorInfo :: Text -> Command m i v (AuthorInfo v Ann)

parser-typechecker/src/Unison/Codebase/Editor/HandleCommand.hs

@@ -54,6 +54,7 @@ import           Unison.FileParsers             ( parseAndSynthesizeFile
 import qualified Unison.PrettyPrintEnv         as PPE
 import Unison.Term (Term)
 import Unison.Type (Type)
+import qualified Unison.Codebase.Editor.AuthorInfo as AuthorInfo
 
 typecheck
   :: (Monad m, Var v)
@@ -190,6 +191,7 @@ commandLine config awaitInput setBranchRef rt notifyUser notifyNumbered loadSour
     Execute ppe uf -> void $ evalUnisonFile ppe uf
     AppendToReflog reason old new -> Codebase.appendReflog codebase reason old new
     LoadReflog -> Codebase.getReflog codebase
+    CreateAuthorInfo t -> AuthorInfo.createAuthorInfo Parser.Intrinsic t
 
   eval1 :: PPE.PrettyPrintEnv -> Term v Ann -> _
   eval1 ppe tm = do

parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs

@@ -128,6 +128,7 @@ import Unison.Codebase.GitError (GitError)
 import Unison.Util.Monoid (intercalateMap)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as Nel
+import Unison.Codebase.Editor.AuthorInfo (AuthorInfo(..))
 
 type F m i v = Free (Command m i v)
 
@@ -415,6 +416,7 @@ loop = do
           LoadI{} -> wat
           PreviewAddI{} -> wat
           PreviewUpdateI{} -> wat
+          CreateAuthorI (NameSegment id) name -> "create.author " <> id <> " " <> name
           CreatePullRequestI{} -> wat
           LoadPullRequestI base head dest ->
             "pr.load "
@@ -967,6 +969,36 @@ loop = do
             numberedArgs .= fmap (HQ.toString . view _1) out
             respond $ ListOfLinks ppe out
 
+      CreateAuthorI authorNameSegment authorFullName -> do
+        initialBranch <- getAt currentPath'
+        AuthorInfo
+          guid@(guidRef, _, _)
+          author@(authorRef, _, _)
+          copyrightHolder@(copyrightHolderRef, _, _) <-
+          eval $ CreateAuthorInfo authorFullName
+        -- add the new definitions to the codebase and to the namespace
+        traverse_ (eval . uncurry3 PutTerm) [guid, author, copyrightHolder]
+        stepManyAt
+          [ BranchUtil.makeAddTermName (resolveSplit' authorPath) (d authorRef) mempty
+          , BranchUtil.makeAddTermName (resolveSplit' copyrightHolderPath) (d copyrightHolderRef) mempty
+          , BranchUtil.makeAddTermName (resolveSplit' guidPath) (d guidRef) mempty
+          ]
+        finalBranch <- getAt currentPath'
+        -- print some output
+        diffHelper (Branch.head initialBranch) (Branch.head finalBranch) >>=
+          respondNumbered
+            . uncurry (ShowDiffAfterCreateAuthor
+                        authorNameSegment
+                        (Path.unsplit' base)
+                        currentPath')
+        where
+        d :: Reference.Id -> Referent
+        d = Referent.Ref . Reference.DerivedId
+        base :: Path.Split' = (Path.relativeEmpty', "metadata")
+        authorPath = base |> "authors" |> authorNameSegment
+        copyrightHolderPath = base |> "copyrightHolders" |> authorNameSegment
+        guidPath = authorPath |> "guid"
+
       MoveTermI src dest ->
         case (toList (getHQ'Terms src), toList (getTerms dest)) of
           ([r], []) -> do

parser-typechecker/src/Unison/Codebase/Editor/Input.hs

@@ -19,6 +19,7 @@ import           Unison.ShortHash (ShortHash)
 import           Unison.Codebase.ShortBranchHash (ShortBranchHash)
 import qualified Unison.Codebase.ShortBranchHash as SBH
 import qualified Data.Text as Text
+import Unison.Codebase.NameSegment (NameSegment)
 
 data Event
   = UnisonFileChanged SourceName Source
@@ -112,6 +113,7 @@ data Input
   | UnlinkI HQ.HashQualified [Path.HQSplit']
   -- links from <type>
   | LinksI Path.HQSplit' (Maybe String)
+  | CreateAuthorI NameSegment {- identifier -} Text {- name -}
   | DisplayI OutputLocation HQ.HashQualified
   | DocsI Path.HQSplit'
   -- other

parser-typechecker/src/Unison/Codebase/Editor/Output.hs

@@ -78,6 +78,8 @@ data NumberedOutput v
   | ShowDiffAfterMergePreview Path.Path' Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput v Ann)
   | ShowDiffAfterPull Path.Path' Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput v Ann)
   | ShowDiffAfterCreatePR RemoteNamespace RemoteNamespace PPE.PrettyPrintEnv (BranchDiffOutput v Ann)
+  -- <authorIdentifier> <authorPath> <relativeBase>
+  | ShowDiffAfterCreateAuthor NameSegment Path.Path' Path.Absolute PPE.PrettyPrintEnv (BranchDiffOutput v Ann)
 
 --  | ShowDiff
 
@@ -336,5 +338,6 @@ isNumberedFailure = \case
   ShowDiffAfterUndo{} -> False
   ShowDiffAfterPull{} -> False
   ShowDiffAfterCreatePR{} -> False
+  ShowDiffAfterCreateAuthor{} -> False
 
 

parser-typechecker/src/Unison/Codebase/Path.hs

@@ -374,6 +374,13 @@ instance Snoc Path' Path' NameSegment NameSegment where
       Left abs -> Path' (Left . Absolute $ Lens.snoc (unabsolute abs) n)
       Right rel -> Path' (Right . Relative $ Lens.snoc (unrelative rel) n)
 
+instance Snoc Split' Split' NameSegment NameSegment where
+  _Snoc = prism (uncurry snoc') $ \case -- unsnoc
+    (Lens.unsnoc -> Just (s, a), ns) -> Right ((s, a), ns)
+    e -> Left e    
+    where
+    snoc' :: Split' -> NameSegment -> Split'
+    snoc' (p, a) n = (Lens.snoc p a, n)
 
 class Resolve l r o where
   resolve :: l -> r -> o

parser-typechecker/src/Unison/CommandLine/InputPatterns.hs

@@ -1212,6 +1212,24 @@ execute = InputPattern
     _   -> Left $ showPatternHelp execute
   )
 
+createAuthor :: InputPattern
+createAuthor = InputPattern "create.author" []
+  [(Required, noCompletions), (Required, noCompletions)]
+  (makeExample createAuthor ["alicecoder", "\"Alice McGee\""]
+    <> "creates" <> backtick "alicecoder" <> "values in"
+    <> backtick "metadata.authors" <> "and"
+    <> backtickEOS "metadata.copyrightHolders")
+  (\case
+      symbolStr : authorStr@(_:_) -> first fromString $ do
+        symbol <- Path.wordyNameSegment symbolStr
+        -- let's have a real parser in not too long
+        let author :: Text
+            author = Text.pack $ case (unwords authorStr) of
+              quoted@('"':_) -> (init . tail) quoted
+              bare -> bare
+        pure $ Input.CreateAuthorI symbol author
+      _   -> Left $ showPatternHelp createAuthor
+    )
 validInputs :: [InputPattern]
 validInputs =
   [ help
@@ -1262,6 +1280,7 @@ validInputs =
   , link
   , unlink
   , links
+  , createAuthor
   , replaceTerm
   , replaceType
   , deleteTermReplacement

parser-typechecker/src/Unison/CommandLine/OutputMessages.hs

@@ -223,6 +223,14 @@ notifyNumbered o = case o of
         --  since the content isn't necessarily here.
         -- Should we have a mode with no numbers? :P
 
+  ShowDiffAfterCreateAuthor authorNS authorPath' bAbs ppe diff ->
+    first (\p -> P.lines
+      [ p
+      , ""
+      , tip $ "Add" <> prettyName "License" <> "values for"
+           <> prettyName (NameSegment.toName authorNS)
+           <> "under" <> P.group (prettyPath' authorPath' <> ".")
+      ]) (showDiffNamespace ShowNumbers ppe bAbs bAbs diff)
   where
     e = Path.absoluteEmpty
     undoTip = tip $ "You can use" <> IP.makeExample' IP.undo

parser-typechecker/unison-parser-typechecker.cabal

@@ -44,6 +44,7 @@ library
     Unison.Codebase.Causal
     Unison.Codebase.Classes
     Unison.Codebase.CodeLookup
+    Unison.Codebase.Editor.AuthorInfo
     Unison.Codebase.Editor.Command
     Unison.Codebase.Editor.DisplayThing
     Unison.Codebase.Editor.Git

unison-src/transcripts/create-author.md

@@ -0,0 +1,25 @@
+```ucm:hide
+.> alias.type ##Nat basics.Nat
+.> alias.type #5hi1vvs5t1 basics.Author
+.> alias.type #rc29vdqe01 basics.GUID
+.> alias.type #aohndsu9bl basics.CopyrightHolder
+```
+<!-- pending bugfix
+```
+.> alias.term #aohndsu9bl#0 basics.CopyrightHolder
+```
+-->
+
+Demonstrating `create.author`:
+
+```unison
+def1 = 1
+def2 = 2
+```
+
+```ucm
+.foo> add
+.foo> create.author alicecoder "Alice McGee"
+.foo> view 3
+.foo> link metadata.authors.alicecoder def1 def2
+```

unison-src/transcripts/create-author.output.md

@@ -0,0 +1,67 @@
+<!-- pending bugfix
+```
+.> alias.term #aohndsu9bl#0 basics.CopyrightHolder
+
+```
+
+-->
+
+Demonstrating `create.author`:
+
+```unison
+def1 = 1
+def2 = 2
+```
+
+```ucm
+
+  I found and typechecked these definitions in scratch.u. If you
+  do an `add` or `update`, here's how your codebase would
+  change:
+  
+    ⍟ These new definitions are ok to `add`:
+    
+      def1 : Nat
+      def2 : Nat
+   
+  Now evaluating any watch expressions (lines starting with
+  `>`)... Ctrl+C cancels.
+
+```
+```ucm
+  ☝️  The namespace .foo is empty.
+
+.foo> add
+
+  ⍟ I've added these definitions:
+  
+    def1 : Nat
+    def2 : Nat
+
+.foo> create.author alicecoder "Alice McGee"
+
+  Added definitions:
+  
+    1. metadata.authors.alicecoder          : Author
+    2. metadata.authors.alicecoder.guid     : GUID
+    3. metadata.copyrightHolders.alicecoder : CopyrightHolder
+  
+  Tip: Add License values for alicecoder under metadata.
+
+.foo> view 3
+
+  metadata.copyrightHolders.alicecoder : CopyrightHolder
+  metadata.copyrightHolders.alicecoder =
+    #aohndsu9bl#0 guid "Alice McGee"
+
+.foo> link metadata.authors.alicecoder def1 def2
+
+  Updates:
+  
+    1. foo.def1 : Nat
+       + 2. authors.alicecoder : Author
+    
+    3. foo.def2 : Nat
+       + 4. authors.alicecoder : Author
+
+```