{-# OPTIONS_GHC -Wno-orphans #-}
module Morley.Michelson.Typed.Doc
( buildInstrDoc
, buildInstrDocWithGitRev
, modifyInstrDoc
, modifyInstrAllDoc
, cutInstrNonDoc
, docInstr
) where
import Control.Lens (at)
import Control.Monad.Writer.Strict (Writer, runWriter, writer)
import Data.Default (def)
import Data.Typeable (cast)
import Prelude hiding (Ordering(..))
import Morley.Michelson.Doc
import Morley.Michelson.Typed.Aliases
import Morley.Michelson.Typed.Contract
import Morley.Michelson.Typed.Instr
import Morley.Michelson.Typed.Util
someDefinitionDocItemToContractDoc :: SomeDocDefinitionItem -> State ContractDoc ()
someDefinitionDocItemToContractDoc :: SomeDocDefinitionItem -> State ContractDoc ()
someDefinitionDocItemToContractDoc sdi :: SomeDocDefinitionItem
sdi@(SomeDocDefinitionItem d
di) =
(ContractDoc -> ContractDoc) -> State ContractDoc ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ContractDoc -> ContractDoc) -> State ContractDoc ())
-> (ContractDoc -> ContractDoc) -> State ContractDoc ()
forall a b. (a -> b) -> a -> b
$ (ContractDoc -> ContractDoc -> ContractDoc)
-> ContractDoc -> ContractDoc -> ContractDoc
forall a b c. (a -> b -> c) -> b -> a -> c
flip ContractDoc -> ContractDoc -> ContractDoc
forall a. Monoid a => a -> a -> a
mappend
ContractDoc
forall a. Monoid a => a
mempty
{ cdContents :: DocBlock
cdContents = DocBlock
forall a. Monoid a => a
mempty
, cdDefinitions :: DocBlock
cdDefinitions = d -> DocBlock
forall di. DocItem di => di -> DocBlock
docItemToBlock d
di
, cdDefinitionsSet :: Set SomeDocDefinitionItem
cdDefinitionsSet = OneItem (Set SomeDocDefinitionItem) -> Set SomeDocDefinitionItem
forall x. One x => OneItem x -> x
one OneItem (Set SomeDocDefinitionItem)
SomeDocDefinitionItem
sdi
, cdDefinitionIds :: Set DocItemId
cdDefinitionIds = OneItem (Set DocItemId) -> Set DocItemId
forall x. One x => OneItem x -> x
one (OneItem (Set DocItemId) -> Set DocItemId)
-> OneItem (Set DocItemId) -> Set DocItemId
forall a b. (a -> b) -> a -> b
$ case d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
forall d.
DocItem d =>
d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
docItemRef d
di of
DocItemRef DocItemId
docItemId -> OneItem (Set DocItemId)
DocItemId
docItemId
}
someDocItemToContractDoc :: SomeDocItem -> State ContractDoc ()
someDocItemToContractDoc :: SomeDocItem -> State ContractDoc ()
someDocItemToContractDoc (SomeDocItem d
di) = do
() <- case d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
forall d.
DocItem d =>
d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
docItemRef d
di of
DocItemRef (DocItemPlacement d) (DocItemReferenced d)
DocItemNoRef ->
(ContractDoc -> ContractDoc) -> State ContractDoc ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ContractDoc -> ContractDoc -> ContractDoc
forall a. Semigroup a => a -> a -> a
<> ContractDoc
forall a. Monoid a => a
mempty{ cdContents :: DocBlock
cdContents = d -> DocBlock
forall di. DocItem di => di -> DocBlock
docItemToBlock d
di })
DocItemRefInlined{} ->
(ContractDoc -> ContractDoc) -> State ContractDoc ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ContractDoc -> ContractDoc -> ContractDoc
forall a. Semigroup a => a -> a -> a
<> ContractDoc
forall a. Monoid a => a
mempty{ cdContents :: DocBlock
cdContents = d -> DocBlock
forall di. DocItem di => di -> DocBlock
docItemToBlock d
di })
DocItemRef{} ->
SomeDocDefinitionItem -> State ContractDoc ()
someDefinitionDocItemToContractDoc (d -> SomeDocDefinitionItem
forall d.
(DocItem d, DocItemPlacement d ~ 'DocItemInDefinitions) =>
d -> SomeDocDefinitionItem
SomeDocDefinitionItem d
di)
[SomeDocDefinitionItem]
-> (Element [SomeDocDefinitionItem] -> State ContractDoc ())
-> State ContractDoc ()
forall t (m :: * -> *) b.
(Container t, Monad m) =>
t -> (Element t -> m b) -> m ()
forM_ @_ @_ @() (d -> [SomeDocDefinitionItem]
forall d. DocItem d => d -> [SomeDocDefinitionItem]
docItemDependencies d
di) ((Element [SomeDocDefinitionItem] -> State ContractDoc ())
-> State ContractDoc ())
-> (Element [SomeDocDefinitionItem] -> State ContractDoc ())
-> State ContractDoc ()
forall a b. (a -> b) -> a -> b
$ \(SomeDocDefinitionItem dep) ->
case d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
forall d.
DocItem d =>
d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
docItemRef d
dep of
DocItemRef{} -> do
Maybe ()
isPresent <- Getting (Maybe ()) ContractDoc (Maybe ())
-> StateT ContractDoc Identity (Maybe ())
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (Maybe ()) ContractDoc (Maybe ())
-> StateT ContractDoc Identity (Maybe ()))
-> Getting (Maybe ()) ContractDoc (Maybe ())
-> StateT ContractDoc Identity (Maybe ())
forall a b. (a -> b) -> a -> b
$ (Set SomeDocDefinitionItem
-> Const (Maybe ()) (Set SomeDocDefinitionItem))
-> ContractDoc -> Const (Maybe ()) ContractDoc
Lens' ContractDoc (Set SomeDocDefinitionItem)
cdDefinitionsSetL ((Set SomeDocDefinitionItem
-> Const (Maybe ()) (Set SomeDocDefinitionItem))
-> ContractDoc -> Const (Maybe ()) ContractDoc)
-> ((Maybe () -> Const (Maybe ()) (Maybe ()))
-> Set SomeDocDefinitionItem
-> Const (Maybe ()) (Set SomeDocDefinitionItem))
-> Getting (Maybe ()) ContractDoc (Maybe ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Set SomeDocDefinitionItem)
-> Lens'
(Set SomeDocDefinitionItem)
(Maybe (IxValue (Set SomeDocDefinitionItem)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (d -> SomeDocDefinitionItem
forall d.
(DocItem d, DocItemPlacement d ~ 'DocItemInDefinitions) =>
d -> SomeDocDefinitionItem
SomeDocDefinitionItem d
dep)
case Maybe ()
isPresent of
Just () -> State ContractDoc ()
forall (f :: * -> *). Applicative f => f ()
pass
Maybe ()
Nothing -> SomeDocItem -> State ContractDoc ()
someDocItemToContractDoc (d -> SomeDocItem
forall d. DocItem d => d -> SomeDocItem
SomeDocItem d
dep)
docInstr :: DocItem di => di -> Instr s s
docInstr :: di -> Instr s s
docInstr = ExtInstr s -> Instr s s
forall (s :: [T]). ExtInstr s -> Instr s s
Ext (ExtInstr s -> Instr s s) -> (di -> ExtInstr s) -> di -> Instr s s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeDocItem -> ExtInstr s
forall (s :: [T]). SomeDocItem -> ExtInstr s
DOC_ITEM (SomeDocItem -> ExtInstr s)
-> (di -> SomeDocItem) -> di -> ExtInstr s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. di -> SomeDocItem
forall d. DocItem d => d -> SomeDocItem
SomeDocItem
{-# DEPRECATED buildInstrDocWithGitRev
"Use `buildDoc . attachDocCommons gitRev` instead."
#-}
buildInstrDocWithGitRev :: DGitRevision -> Instr inp out -> ContractDoc
buildInstrDocWithGitRev :: DGitRevision -> Instr inp out -> ContractDoc
buildInstrDocWithGitRev DGitRevision
gitRev Instr inp out
contract =
let toc :: DToc
toc = Markdown -> DToc
DToc (Markdown -> DToc) -> Markdown -> DToc
forall a b. (a -> b) -> a -> b
$ ContractDoc -> Markdown
contractDocToToc (ContractDoc -> Markdown) -> ContractDoc -> Markdown
forall a b. (a -> b) -> a -> b
$ Instr inp out -> ContractDoc
forall (inp :: [T]) (out :: [T]). Instr inp out -> ContractDoc
buildInstrDoc Instr inp out
contract
c :: WithFinalizedDoc (Instr inp out)
c = Instr inp out -> WithFinalizedDoc (Instr inp out)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instr inp out
contract
WithFinalizedDoc (Instr inp out)
-> (Instr inp out -> WithFinalizedDoc (Instr inp out))
-> WithFinalizedDoc (Instr inp out)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DGitRevision -> Instr inp out -> WithFinalizedDoc (Instr inp out)
forall a.
ContainsUpdateableDoc a =>
DGitRevision -> a -> WithFinalizedDoc a
attachGitInfo DGitRevision
gitRev
WithFinalizedDoc (Instr inp out)
-> (Instr inp out -> WithFinalizedDoc (Instr inp out))
-> WithFinalizedDoc (Instr inp out)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DToc -> Instr inp out -> WithFinalizedDoc (Instr inp out)
forall a.
ContainsUpdateableDoc a =>
DToc -> a -> WithFinalizedDoc a
attachToc DToc
toc
in WithFinalizedDoc (Instr inp out) -> ContractDoc
forall a. ContainsDoc a => WithFinalizedDoc a -> ContractDoc
buildDoc WithFinalizedDoc (Instr inp out)
c
{-# DEPRECATED buildInstrDoc "Use 'buildDoc' instead." #-}
buildInstrDoc :: Instr inp out -> ContractDoc
buildInstrDoc :: Instr inp out -> ContractDoc
buildInstrDoc = DfsSettings (Writer ContractDoc)
-> (forall (inp :: [T]) (out :: [T]). Instr inp out -> ContractDoc)
-> Instr inp out
-> ContractDoc
forall x (inp :: [T]) (out :: [T]).
Monoid x =>
DfsSettings (Writer x)
-> (forall (i :: [T]) (o :: [T]). Instr i o -> x)
-> Instr inp out
-> x
dfsFoldInstr DfsSettings (Writer ContractDoc)
dfsSettings ((forall (inp :: [T]) (out :: [T]). Instr inp out -> ContractDoc)
-> Instr inp out -> ContractDoc)
-> (forall (inp :: [T]) (out :: [T]). Instr inp out -> ContractDoc)
-> Instr inp out
-> ContractDoc
forall a b. (a -> b) -> a -> b
$ \case
Ext ExtInstr i
ext -> case ExtInstr i
ext of
DOC_ITEM SomeDocItem
sdi ->
State ContractDoc () -> ContractDoc -> ContractDoc
forall s a. State s a -> s -> s
execState (SomeDocItem -> State ContractDoc ()
someDocItemToContractDoc SomeDocItem
sdi) ContractDoc
forall a. Monoid a => a
mempty
ExtInstr i
_ -> ContractDoc
forall a. Monoid a => a
mempty
Instr i o
_ -> ContractDoc
forall a. Monoid a => a
mempty
where
dfsSettings :: DfsSettings (Writer ContractDoc)
dfsSettings :: DfsSettings (Writer ContractDoc)
dfsSettings = DfsSettings Any
forall a. Default a => a
def
{ dsCtorEffectsApp :: CtorEffectsApp (Writer ContractDoc)
dsCtorEffectsApp = CtorEffectsApp :: forall (m :: * -> *).
Text
-> (forall (i :: [T]) (o :: [T]).
Monad m =>
Instr i o -> m (Instr i o) -> m (Instr i o))
-> CtorEffectsApp m
CtorEffectsApp
{ ceaName :: Text
ceaName = Text
"Building DocGroup"
, ceaPostStep :: forall (i :: [T]) (o :: [T]).
Monad (Writer ContractDoc) =>
Instr i o
-> Writer ContractDoc (Instr i o) -> Writer ContractDoc (Instr i o)
ceaPostStep = \Instr i o
_old -> \case
(Writer ContractDoc (Instr i o) -> (Instr i o, ContractDoc)
forall w a. Writer w a -> (a, w)
runWriter -> (i :: Instr i o
i@(DocGroup DocGrouping
grouping Instr i o
_), ContractDoc
resChildren)) ->
(Instr i o, ContractDoc) -> Writer ContractDoc (Instr i o)
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer (Instr i o
i, DocGrouping -> ContractDoc -> ContractDoc
docGroupContent DocGrouping
grouping ContractDoc
resChildren)
Writer ContractDoc (Instr i o)
other -> Writer ContractDoc (Instr i o)
other
}
}
{-# DEPRECATED modifyInstrAllDoc "Use 'modifyDocEntirely' instead." #-}
modifyInstrAllDoc
:: (SomeDocItem -> SomeDocItem)
-> Instr inp out
-> Instr inp out
modifyInstrAllDoc :: (SomeDocItem -> SomeDocItem) -> Instr inp out -> Instr inp out
modifyInstrAllDoc SomeDocItem -> SomeDocItem
mapper = DfsSettings Identity
-> (forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o)
-> Instr inp out
-> Instr inp out
forall (inp :: [T]) (out :: [T]).
DfsSettings Identity
-> (forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o)
-> Instr inp out
-> Instr inp out
dfsModifyInstr DfsSettings Identity
forall a. Default a => a
def ((forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o)
-> Instr inp out -> Instr inp out)
-> (forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o)
-> Instr inp out
-> Instr inp out
forall a b. (a -> b) -> a -> b
$ \case
Ext ExtInstr i
ext -> ExtInstr i -> Instr i i
forall (s :: [T]). ExtInstr s -> Instr s s
Ext (ExtInstr i -> Instr i i) -> ExtInstr i -> Instr i i
forall a b. (a -> b) -> a -> b
$
case ExtInstr i
ext of
DOC_ITEM SomeDocItem
sdi -> SomeDocItem -> ExtInstr i
forall (s :: [T]). SomeDocItem -> ExtInstr s
DOC_ITEM (SomeDocItem -> SomeDocItem
mapper SomeDocItem
sdi)
ExtInstr i
i -> ExtInstr i
i
Instr i o
i -> Instr i o
i
{-# DEPRECATED modifyInstrDoc "Use 'modifyDoc' instead." #-}
modifyInstrDoc
:: (DocItem i1, DocItem i2)
=> (i1 -> Maybe i2)
-> Instr inp out
-> Instr inp out
modifyInstrDoc :: (i1 -> Maybe i2) -> Instr inp out -> Instr inp out
modifyInstrDoc i1 -> Maybe i2
mapper = (SomeDocItem -> SomeDocItem) -> Instr inp out -> Instr inp out
forall (inp :: [T]) (out :: [T]).
(SomeDocItem -> SomeDocItem) -> Instr inp out -> Instr inp out
modifyInstrAllDoc SomeDocItem -> SomeDocItem
untypedMapper
where
untypedMapper :: SomeDocItem -> SomeDocItem
untypedMapper sdi :: SomeDocItem
sdi@(SomeDocItem d
di) = SomeDocItem -> Maybe SomeDocItem -> SomeDocItem
forall a. a -> Maybe a -> a
fromMaybe SomeDocItem
sdi (Maybe SomeDocItem -> SomeDocItem)
-> Maybe SomeDocItem -> SomeDocItem
forall a b. (a -> b) -> a -> b
$ do
i1
di' <- d -> Maybe i1
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast d
di
i2
newDi <- i1 -> Maybe i2
mapper i1
di'
return (i2 -> SomeDocItem
forall d. DocItem d => d -> SomeDocItem
SomeDocItem i2
newDi)
instance ContainsDoc (Instr inp out) where
buildDocUnfinalized :: Instr inp out -> ContractDoc
buildDocUnfinalized = Instr inp out -> ContractDoc
forall (inp :: [T]) (out :: [T]). Instr inp out -> ContractDoc
buildInstrDoc
instance ContainsUpdateableDoc (Instr inp out) where
modifyDocEntirely :: (SomeDocItem -> SomeDocItem) -> Instr inp out -> Instr inp out
modifyDocEntirely = (SomeDocItem -> SomeDocItem) -> Instr inp out -> Instr inp out
forall (inp :: [T]) (out :: [T]).
(SomeDocItem -> SomeDocItem) -> Instr inp out -> Instr inp out
modifyInstrAllDoc
instance ContainsDoc (Contract cp st) where
buildDocUnfinalized :: Contract cp st -> ContractDoc
buildDocUnfinalized = ContractCode' Instr cp st -> ContractDoc
forall a. ContainsDoc a => a -> ContractDoc
buildDocUnfinalized (ContractCode' Instr cp st -> ContractDoc)
-> (Contract cp st -> ContractCode' Instr cp st)
-> Contract cp st
-> ContractDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contract cp st -> ContractCode' Instr cp st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ContractCode' instr cp st
cCode
instance ContainsUpdateableDoc (Contract cp st) where
modifyDocEntirely :: (SomeDocItem -> SomeDocItem) -> Contract cp st -> Contract cp st
modifyDocEntirely SomeDocItem -> SomeDocItem
how Contract cp st
contract =
Contract cp st
contract{ cCode :: ContractCode' Instr cp st
cCode = (SomeDocItem -> SomeDocItem)
-> ContractCode' Instr cp st -> ContractCode' Instr cp st
forall (inp :: [T]) (out :: [T]).
(SomeDocItem -> SomeDocItem) -> Instr inp out -> Instr inp out
modifyInstrAllDoc SomeDocItem -> SomeDocItem
how (Contract cp st -> ContractCode' Instr cp st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ContractCode' instr cp st
cCode Contract cp st
contract) }
cutInstrNonDoc :: (forall i o. Instr i o -> Instr i o) -> Instr inp out -> Instr s s
cutInstrNonDoc :: (forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o)
-> Instr inp out -> Instr s s
cutInstrNonDoc forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
optimize = Instr s s -> Instr s s
forall (i :: [T]) (o :: [T]). Instr i o -> Instr i o
optimize (Instr s s -> Instr s s)
-> (Instr inp out -> Instr s s) -> Instr inp out -> Instr s s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DfsSettings (Writer (Instr s s))
-> (forall (i :: [T]) (o :: [T]). Instr i o -> Instr s s)
-> Instr inp out
-> Instr s s
forall x (inp :: [T]) (out :: [T]).
Monoid x =>
DfsSettings (Writer x)
-> (forall (i :: [T]) (o :: [T]). Instr i o -> x)
-> Instr inp out
-> x
dfsFoldInstr DfsSettings (Writer (Instr s s))
forall (s :: [T]). DfsSettings $ Writer (Instr s s)
dfsSettings forall (i :: [T]) (o :: [T]). Instr i o -> Instr s s
forall (inp :: [T]) (out :: [T]) (s :: [T]).
Instr inp out -> Instr s s
step
where
dfsSettings :: DfsSettings $ Writer (Instr s s)
dfsSettings :: DfsSettings $ Writer (Instr s s)
dfsSettings = DfsSettings Any
forall a. Default a => a
def
{ dsCtorEffectsApp :: CtorEffectsApp (Writer (Instr s s))
dsCtorEffectsApp = CtorEffectsApp :: forall (m :: * -> *).
Text
-> (forall (i :: [T]) (o :: [T]).
Monad m =>
Instr i o -> m (Instr i o) -> m (Instr i o))
-> CtorEffectsApp m
CtorEffectsApp
{ ceaName :: Text
ceaName = Text
"Wrap into DocGroup"
, ceaPostStep :: forall (i :: [T]) (o :: [T]).
Monad (Writer (Instr s s)) =>
Instr i o
-> Writer (Instr s s) (Instr i o) -> Writer (Instr s s) (Instr i o)
ceaPostStep = \Instr i o
_old -> \case
(Writer (Instr s s) (Instr i o) -> (Instr i o, Instr s s)
forall w a. Writer w a -> (a, w)
runWriter -> (i :: Instr i o
i@(DocGroup DocGrouping
g Instr i o
_), Instr s s
resChildren)) ->
(Instr i o, Instr s s) -> Writer (Instr s s) (Instr i o)
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer (Instr i o
i, DocGrouping -> Instr s s -> Instr s s
forall (inp :: [T]) (out :: [T]).
DocGrouping -> Instr inp out -> Instr inp out
DocGroup DocGrouping
g Instr s s
resChildren)
Writer (Instr s s) (Instr i o)
other -> Writer (Instr s s) (Instr i o)
other
}
}
step :: Instr inp out -> Instr s s
step :: Instr inp out -> Instr s s
step = \case
Ext ExtInstr inp
ext -> case ExtInstr inp
ext of
DOC_ITEM SomeDocItem
di -> ExtInstr s -> Instr s s
forall (s :: [T]). ExtInstr s -> Instr s s
Ext (ExtInstr s -> Instr s s) -> ExtInstr s -> Instr s s
forall a b. (a -> b) -> a -> b
$ SomeDocItem -> ExtInstr s
forall (s :: [T]). SomeDocItem -> ExtInstr s
DOC_ITEM SomeDocItem
di
ExtInstr inp
_ -> Instr s s
forall (s :: [T]). Instr s s
Nop
Instr inp out
_ -> Instr s s
forall (s :: [T]). Instr s s
Nop