{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Dhall.DirectoryTree
(
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
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{..}
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