{-# LANGUAGE OverloadedLists   #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE ViewPatterns      #-}

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

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

import qualified Control.Exception           as Exception
import qualified Data.Foldable               as Foldable
import qualified Data.Text                   as Text
import qualified Data.Text.IO                as Text.IO
import qualified Dhall.Map                   as Map
import qualified Dhall.Pretty
import qualified Dhall.Util                  as Util
import qualified Prettyprinter.Render.String as Pretty
import qualified System.Directory            as Directory
import qualified System.FilePath             as FilePath

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

    * Records are translated into directories

    * @Map@s are also 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 cannot be converted as-is.
-}
toDirectoryTree :: FilePath -> Expr Void Void -> IO ()
toDirectoryTree :: FilePath -> Expr Void Void -> IO ()
toDirectoryTree FilePath
path Expr Void Void
expression = case Expr Void Void
expression of
    RecordLit Map Text (RecordField Void Void)
keyValues ->
        (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) -> IO ())
-> Map Text (Expr Void Void) -> IO ()
forall a b. (a -> b) -> a -> b
$ RecordField Void Void -> Expr Void Void
forall s a. RecordField s a -> Expr s a
recordFieldValue (RecordField Void Void -> Expr Void Void)
-> Map Text (RecordField Void Void) -> Map Text (Expr Void Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (RecordField Void Void)
keyValues

    ListLit (Just (Record [ ("mapKey", recordFieldValue -> Text), ("mapValue", _) ])) [] ->
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    ListLit Maybe (Expr Void Void)
_ Seq (Expr Void Void)
records
        | Bool -> Bool
not (Seq (Expr Void Void) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq (Expr Void Void)
records)
        , Just [(Text, Expr Void Void)]
keyValues <- [Expr Void Void] -> Maybe [(Text, Expr Void Void)]
forall (m :: * -> *) s a.
(Monad m, Alternative m) =>
[Expr s a] -> m [(Text, Expr s a)]
extract (Seq (Expr Void Void) -> [Expr Void Void]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq (Expr Void Void)
records) ->
            ((Text, Expr Void Void) -> IO ())
-> [(Text, Expr Void Void)] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
Foldable.traverse_ ((Text -> Expr Void Void -> IO ())
-> (Text, Expr Void Void) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Expr Void Void -> IO ()
process) [(Text, Expr Void Void)]
keyValues

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

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

    App (Field (Union Map Text (Maybe (Expr Void Void))
_) FieldSelection Void
_) Expr Void Void
value ->
        FilePath -> Expr Void Void -> IO ()
toDirectoryTree FilePath
path Expr Void Void
value

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

    Expr Void Void
_ ->
        IO ()
forall a. IO a
die
  where
    extract :: [Expr s a] -> m [(Text, Expr s a)]
extract [] =
        [(Text, Expr s a)] -> m [(Text, Expr s a)]
forall (m :: * -> *) a. Monad m => a -> m a
return []

    extract (RecordLit [ ("mapKey", recordFieldValue -> TextLit (Chunks [] key))
                       , ("mapValue", recordFieldValue -> value)] : [Expr s a]
records) =
        ([(Text, Expr s a)] -> [(Text, Expr s a)])
-> m [(Text, Expr s a)] -> m [(Text, Expr s a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text
key, Expr s a
value) (Text, Expr s a) -> [(Text, Expr s a)] -> [(Text, Expr s a)]
forall a. a -> [a] -> [a]
:) ([Expr s a] -> m [(Text, Expr s a)]
extract [Expr s a]
records)

    extract [Expr s a]
_ =
        m [(Text, Expr s a)]
forall (f :: * -> *) a. Alternative f => f a
empty

    process :: Text -> Expr Void Void -> IO ()
process Text
key Expr Void Void
value = do
        if Text -> Text -> Bool
Text.isInfixOf (FilePath -> Text
Text.pack [ Char
Item FilePath
FilePath.pathSeparator ]) Text
key
            then IO ()
forall a. IO a
die
            else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        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

    die :: IO a
die = FilesystemError -> IO a
forall e a. Exception e => e -> IO a
Exception.throwIO FilesystemError :: Expr Void Void -> FilesystemError
FilesystemError{Expr Void Void
unexpectedExpression :: Expr Void Void
unexpectedExpression :: Expr Void Void
..}
      where
        unexpectedExpression :: Expr Void Void
unexpectedExpression = Expr Void Void
expression

{- | This error indicates that you supplied an invalid Dhall expression to the
     `toDirectoryTree` 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{Expr Void Void
unexpectedExpression :: Expr Void Void
unexpectedExpression :: FilesystemError -> Expr Void Void
..} =
        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
<> Doc Ann
": 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 or maps can be converted to directories,      \n\
          \❰Text❱ literals can be converted to files, and ❰Optional❱ values are included if   \n\
          \❰Some❱ and omitted if ❰None❱.  Values of union types can also be converted if      \n\
          \they are an alternative which has a non-nullary constructor whose argument is of   \n\
          \an otherwise convertible type.  No other type of value can be translated to a      \n\
          \directory 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\
          \Note that key names cannot contain path separators:                                \n\
          \                                                                                   \n\
          \                                                                                   \n\
          \    ┌─────────────────────────────────────┐                                        \n\
          \    │ { `directory/example.txt` = \"ABC\" } │ Invalid: Key contains a forward slash\n\
          \    └─────────────────────────────────────┘                                        \n\
          \                                                                                   \n\
          \                                                                                   \n\
          \Instead, you need to refactor the expression to use nested records instead:        \n\
          \                                                                                   \n\
          \                                                                                   \n\
          \    ┌───────────────────────────────────────────┐                                  \n\
          \    │ { directory = { `example.txt` = \"ABC\" } } │                                \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
<> Doc Ann
"\n\
          \                                                                                   \n\
          \... which is not an expression that can be translated to a directory tree.         \n"

instance Exception FilesystemError