{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

-- | Implementation of the @dhall to-directory-tree@ subcommand
module Dhall.DirectoryTree
    ( -- * Filesystem
      toDirectoryTree
    , FilesystemError(..)
    ) where

import Control.Exception (Exception)
import Data.Monoid ((<>))
import Data.Void (Void)
import Dhall.Syntax (Chunks(..), Expr(..))
import System.FilePath ((</>))

import qualified Control.Exception                       as Exception
import qualified Data.Text.Prettyprint.Doc.Render.String as Pretty
import qualified Dhall.Util                              as Util
import qualified Dhall.Map                               as Map
import qualified Dhall.Pretty
import qualified System.Directory                        as Directory
import qualified Data.Text                               as Text
import qualified Data.Text.IO                            as Text.IO

{-| Attempt to transform a Dhall record into a directory tree where:

    * Records are translated into directories

    * @Text@ values or fields are translated into files

    * @Optional@ values are omitted if @None@

    For example, the following Dhall record:

    > { dir = { `hello.txt` = "Hello\n" }
    > , `goodbye.txt`= Some "Goodbye\n"
    > , `missing.txt` = None Text
    > }

    ... should translate to this directory tree:

    > $ tree result
    > result
    > ├── dir
    > │   └── hello.txt
    > └── goodbye.txt
    >
    > $ cat result/dir/hello.txt
    > Hello
    >
    > $ cat result/goodbye.txt
    > Goodbye

    Use this in conjunction with the Prelude's support for rendering JSON/YAML
    in "pure Dhall" so that you can generate files containing JSON.  For
    example:

    > let JSON =
    >       https://prelude.dhall-lang.org/v12.0.0/JSON/package.dhall sha256:843783d29e60b558c2de431ce1206ce34bdfde375fcf06de8ec5bf77092fdef7
    >
    > in  { `example.json` =
    >         JSON.render (JSON.array [ JSON.number 1.0, JSON.bool True ])
    >     , `example.yaml` =
    >         JSON.renderYAML
    >           (JSON.object (toMap { foo = JSON.string "Hello", bar = JSON.null }))
    >     }

    ... which would generate:

    > $ cat result/example.json
    > [ 1.0, true ]
    >
    > $ cat result/example.yaml
    > ! "bar": null
    > ! "foo": "Hello"

    This utility does not take care of type-checking and normalizing the
    provided expression.  This will raise a `FilesystemError` exception upon
    encountering an expression that is not a `TextLit` or `RecordLit`.
-}
toDirectoryTree :: FilePath -> Expr Void Void -> IO ()
toDirectoryTree :: FilePath -> Expr Void Void -> IO ()
toDirectoryTree path :: FilePath
path expression :: Expr Void Void
expression = case Expr Void Void
expression of
    RecordLit keyValues :: Map Text (Expr Void Void)
keyValues -> do
        let process :: Text -> Expr Void Void -> IO ()
process key :: Text
key value :: Expr Void Void
value = do
                Bool -> FilePath -> IO ()
Directory.createDirectoryIfMissing Bool
False FilePath
path

                FilePath -> Expr Void Void -> IO ()
toDirectoryTree (FilePath
path FilePath -> FilePath -> FilePath
</> Text -> FilePath
Text.unpack Text
key) Expr Void Void
value

        (Text -> Expr Void Void -> IO ())
-> Map Text (Expr Void Void) -> IO ()
forall k (f :: * -> *) a.
(Ord k, Applicative f) =>
(k -> a -> f ()) -> Map k a -> f ()
Map.unorderedTraverseWithKey_ Text -> Expr Void Void -> IO ()
process Map Text (Expr Void Void)
keyValues

    TextLit (Chunks [] text :: Text
text) -> do
        FilePath -> Text -> IO ()
Text.IO.writeFile FilePath
path Text
text

    Some value :: Expr Void Void
value -> do
        FilePath -> Expr Void Void -> IO ()
toDirectoryTree FilePath
path Expr Void Void
value

    App None _ -> do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    _ -> do
        let unexpectedExpression :: Expr Void Void
unexpectedExpression = Expr Void Void
expression

        FilesystemError -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO FilesystemError :: Expr Void Void -> FilesystemError
FilesystemError{..}

{- | This error indicates that you supplied an invalid Dhall expression to the
     `directoryTree` function.  The Dhall expression could not be translated to
     a directory tree.
-}
newtype FilesystemError =
    FilesystemError { FilesystemError -> Expr Void Void
unexpectedExpression :: Expr Void Void }

instance Show FilesystemError where
    show :: FilesystemError -> FilePath
show FilesystemError{..} =
        SimpleDocStream Ann -> FilePath
forall ann. SimpleDocStream ann -> FilePath
Pretty.renderString (Doc Ann -> SimpleDocStream Ann
forall ann. Doc ann -> SimpleDocStream ann
Dhall.Pretty.layout Doc Ann
message)
      where
        message :: Doc Ann
message =
          Doc Ann
forall string. IsString string => string
Util._ERROR Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> ": Not a valid directory tree expression\n\
          \                                                                                \n\
          \Explanation: Only a subset of Dhall expressions can be converted to a directory \n\
          \tree.  Specifically, record literals can be converted to directories, ❰Text❱    \n\
          \literals can be converted to files, and ❰Optional❱ values are included if ❰Some❱\n\
          \and omitted if ❰None❱.  No other type of value can be translated to a directory \n\
          \tree.                                                                           \n\
          \                                                                                \n\
          \For example, this is a valid expression that can be translated to a directory   \n\
          \tree:                                                                           \n\
          \                                                                                \n\
          \                                                                                \n\
          \    ┌──────────────────────────────────┐                                        \n\
          \    │ { `example.json` = \"[1, true]\" } │                                      \n\
          \    └──────────────────────────────────┘                                        \n\
          \                                                                                \n\
          \                                                                                \n\
          \In contrast, the following expression is not allowed due to containing a        \n\
          \❰Natural❱ field, which cannot be translated in this way:                        \n\
          \                                                                                \n\
          \                                                                                \n\
          \    ┌───────────────────────┐                                                   \n\
          \    │ { `example.txt` = 1 } │                                                   \n\
          \    └───────────────────────┘                                                   \n\
          \                                                                                \n\
          \                                                                                \n\
          \You tried to translate the following expression to a directory tree:            \n\
          \                                                                                \n\
          \" Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> Expr Void Void -> Doc Ann
forall a. Pretty a => a -> Doc Ann
Util.insert Expr Void Void
unexpectedExpression Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> "\n\
          \                                                                                \n\
          \... which is neither a ❰Text❱ literal, a record literal, nor an ❰Optional❱      \n\
          \value.                                                                          \n"

instance Exception FilesystemError