-- | 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