{-| Machinery defined in this module allows to export mulptiple Plutus Core definitions
(types and terms) as a single value which enables convenient testing of various procedures
(pretty-printing, type checking, etc): each time a function / data type is added to that value,
none of the tests is required to be adapted, instead all the tests see the new definition
automatically. -}
module PlutusCore.FsTree
  ( FsTree (..)
  , FolderContents (..)
  , PlcEntity (..)
  , PlcFsTree
  , PlcFolderContents
  , treeFolderContents
  , plcTypeFile
  , plcTermFile
  , foldFsTree
  , foldPlcFsTree
  , foldPlcFolderContents
  ) where

import PlutusCore.Core
import PlutusCore.Name.Unique

-- We use 'String's for names, because 'FilePath's are 'String's.
-- | An 'FsTree' is either a file or a folder with a list of 'FsTree's inside.
data FsTree a
  = FsFolder String (FolderContents a)
  | FsFile String a

{-| The contents of a folder. A wrapper around @[FsTree a]@.
Exists because of its 'Semigroup' instance which allows to concatenate two 'FolderContents's
without placing them into the same folder immediately, so we can have various PLC "modules"
(@stdlib@, @examples@, etc), define compound modules (e.g. @stdlib <> examples@) and run various
tests (pretty-printing, type synthesis, etc) against simple and compound modules uniformly. -}
newtype FolderContents a = FolderContents
  { forall a. FolderContents a -> [FsTree a]
unFolderContents :: [FsTree a]
  }
  deriving newtype (NonEmpty (FolderContents a) -> FolderContents a
FolderContents a -> FolderContents a -> FolderContents a
(FolderContents a -> FolderContents a -> FolderContents a)
-> (NonEmpty (FolderContents a) -> FolderContents a)
-> (forall b.
    Integral b =>
    b -> FolderContents a -> FolderContents a)
-> Semigroup (FolderContents a)
forall b. Integral b => b -> FolderContents a -> FolderContents a
forall a. NonEmpty (FolderContents a) -> FolderContents a
forall a. FolderContents a -> FolderContents a -> FolderContents a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> FolderContents a -> FolderContents a
$c<> :: forall a. FolderContents a -> FolderContents a -> FolderContents a
<> :: FolderContents a -> FolderContents a -> FolderContents a
$csconcat :: forall a. NonEmpty (FolderContents a) -> FolderContents a
sconcat :: NonEmpty (FolderContents a) -> FolderContents a
$cstimes :: forall a b. Integral b => b -> FolderContents a -> FolderContents a
stimes :: forall b. Integral b => b -> FolderContents a -> FolderContents a
Semigroup, Semigroup (FolderContents a)
FolderContents a
Semigroup (FolderContents a) =>
FolderContents a
-> (FolderContents a -> FolderContents a -> FolderContents a)
-> ([FolderContents a] -> FolderContents a)
-> Monoid (FolderContents a)
[FolderContents a] -> FolderContents a
FolderContents a -> FolderContents a -> FolderContents a
forall a. Semigroup (FolderContents a)
forall a. FolderContents a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [FolderContents a] -> FolderContents a
forall a. FolderContents a -> FolderContents a -> FolderContents a
$cmempty :: forall a. FolderContents a
mempty :: FolderContents a
$cmappend :: forall a. FolderContents a -> FolderContents a -> FolderContents a
mappend :: FolderContents a -> FolderContents a -> FolderContents a
$cmconcat :: forall a. [FolderContents a] -> FolderContents a
mconcat :: [FolderContents a] -> FolderContents a
Monoid)

-- | A 'PlcEntity' is either a 'Type' or a 'Term'.
data PlcEntity uni fun
  = PlcType (Type TyName uni ())
  | PlcTerm (Term TyName Name uni fun ())

type PlcFsTree uni fun = FsTree (PlcEntity uni fun)
type PlcFolderContents uni fun = FolderContents (PlcEntity uni fun)

-- | Construct an 'FsTree' out of the name of a folder and a list of 'FsTree's.
treeFolderContents :: String -> [FsTree a] -> FsTree a
treeFolderContents :: forall a. String -> [FsTree a] -> FsTree a
treeFolderContents String
name = String -> FolderContents a -> FsTree a
forall a. String -> FolderContents a -> FsTree a
FsFolder String
name (FolderContents a -> FsTree a)
-> ([FsTree a] -> FolderContents a) -> [FsTree a] -> FsTree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FsTree a] -> FolderContents a
forall a. [FsTree a] -> FolderContents a
FolderContents

-- | Construct a single-file 'PlcFsTree' out of a type.
plcTypeFile :: String -> Type TyName uni () -> PlcFsTree uni fun
plcTypeFile :: forall (uni :: * -> *) fun.
String -> Type TyName uni () -> PlcFsTree uni fun
plcTypeFile String
name = String -> PlcEntity uni fun -> FsTree (PlcEntity uni fun)
forall a. String -> a -> FsTree a
FsFile String
name (PlcEntity uni fun -> FsTree (PlcEntity uni fun))
-> (Type TyName uni () -> PlcEntity uni fun)
-> Type TyName uni ()
-> FsTree (PlcEntity uni fun)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type TyName uni () -> PlcEntity uni fun
forall (uni :: * -> *) fun. Type TyName uni () -> PlcEntity uni fun
PlcType

-- | Construct a single-file 'PlcFsTree' out of a term.
plcTermFile :: String -> Term TyName Name uni fun () -> PlcFsTree uni fun
plcTermFile :: forall (uni :: * -> *) fun.
String -> Term TyName Name uni fun () -> PlcFsTree uni fun
plcTermFile String
name = String -> PlcEntity uni fun -> FsTree (PlcEntity uni fun)
forall a. String -> a -> FsTree a
FsFile String
name (PlcEntity uni fun -> FsTree (PlcEntity uni fun))
-> (Term TyName Name uni fun () -> PlcEntity uni fun)
-> Term TyName Name uni fun ()
-> FsTree (PlcEntity uni fun)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term TyName Name uni fun () -> PlcEntity uni fun
forall (uni :: * -> *) fun.
Term TyName Name uni fun () -> PlcEntity uni fun
PlcTerm

-- | Fold a 'FsTree'.
foldFsTree
  :: (String -> [b] -> b)
  -- ^ What to do on a folder.
  -> (String -> a -> b)
  -- ^ What to do on a single file in a folder.
  -> FsTree a
  -> b
foldFsTree :: forall b a.
(String -> [b] -> b) -> (String -> a -> b) -> FsTree a -> b
foldFsTree String -> [b] -> b
onFolder String -> a -> b
onFile = FsTree a -> b
go
  where
    go :: FsTree a -> b
go (FsFolder String
name (FolderContents [FsTree a]
trees)) = String -> [b] -> b
onFolder String
name ([b] -> b) -> [b] -> b
forall a b. (a -> b) -> a -> b
$ (FsTree a -> b) -> [FsTree a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map FsTree a -> b
go [FsTree a]
trees
    go (FsFile String
name a
x) = String -> a -> b
onFile String
name a
x

-- | Fold a 'PlcFsTree'.
foldPlcFsTree
  :: (String -> [b] -> b)
  -- ^ What to do on a folder.
  -> (String -> Type TyName uni () -> b)
  -- ^ What to do on a type.
  -> (String -> Term TyName Name uni fun () -> b)
  -- ^ What to do on a term.
  -> PlcFsTree uni fun
  -> b
foldPlcFsTree :: forall b (uni :: * -> *) fun.
(String -> [b] -> b)
-> (String -> Type TyName uni () -> b)
-> (String -> Term TyName Name uni fun () -> b)
-> PlcFsTree uni fun
-> b
foldPlcFsTree String -> [b] -> b
onFolder String -> Type TyName uni () -> b
onType String -> Term TyName Name uni fun () -> b
onTerm = (String -> [b] -> b)
-> (String -> PlcEntity uni fun -> b)
-> FsTree (PlcEntity uni fun)
-> b
forall b a.
(String -> [b] -> b) -> (String -> a -> b) -> FsTree a -> b
foldFsTree String -> [b] -> b
onFolder String -> PlcEntity uni fun -> b
onFile
  where
    onFile :: String -> PlcEntity uni fun -> b
onFile String
name (PlcType Type TyName uni ()
getTy) = String -> Type TyName uni () -> b
onType String
name Type TyName uni ()
getTy
    onFile String
name (PlcTerm Term TyName Name uni fun ()
getTerm) = String -> Term TyName Name uni fun () -> b
onTerm String
name Term TyName Name uni fun ()
getTerm

-- | Fold the contents of a PLC folder.
foldPlcFolderContents
  :: (String -> [b] -> b)
  -- ^ What to do on a folder.
  -> (String -> Type TyName uni () -> b)
  -- ^ What to do on a type.
  -> (String -> Term TyName Name uni fun () -> b)
  -- ^ What to do on a term.
  -> PlcFolderContents uni fun
  -> [b]
foldPlcFolderContents :: forall b (uni :: * -> *) fun.
(String -> [b] -> b)
-> (String -> Type TyName uni () -> b)
-> (String -> Term TyName Name uni fun () -> b)
-> PlcFolderContents uni fun
-> [b]
foldPlcFolderContents String -> [b] -> b
onFolder String -> Type TyName uni () -> b
onType String -> Term TyName Name uni fun () -> b
onTerm (FolderContents [FsTree (PlcEntity uni fun)]
trees) =
  (FsTree (PlcEntity uni fun) -> b)
-> [FsTree (PlcEntity uni fun)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> [b] -> b)
-> (String -> Type TyName uni () -> b)
-> (String -> Term TyName Name uni fun () -> b)
-> FsTree (PlcEntity uni fun)
-> b
forall b (uni :: * -> *) fun.
(String -> [b] -> b)
-> (String -> Type TyName uni () -> b)
-> (String -> Term TyName Name uni fun () -> b)
-> PlcFsTree uni fun
-> b
foldPlcFsTree String -> [b] -> b
onFolder String -> Type TyName uni () -> b
onType String -> Term TyName Name uni fun () -> b
onTerm) [FsTree (PlcEntity uni fun)]
trees