{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase   #-}
{-# LANGUAGE MultiWayIf   #-}

-- | Create a package.dhall from files and directory contents.

module Dhall.Package
    ( writePackage
    , getPackagePathAndContent
    , PackageError(..)
    ) where

import           Control.Exception  (Exception, throwIO)
import           Control.Monad
import           Data.List.NonEmpty (NonEmpty (..))
import           Data.Maybe         (fromMaybe)
import           Data.Text          (Text)
import qualified Data.Text          as Text
import           Data.Traversable   (for)
import           Dhall.Core
    ( Directory (..)
    , Expr (..)
    , File (..)
    , FilePrefix (..)
    , Import (..)
    , ImportHashed (..)
    , ImportMode (..)
    , ImportType (..)
    , RecordField (..)
    , makeRecordField
    )
import           Dhall.Map          (Map)
import qualified Dhall.Map          as Map
import           Dhall.Pretty       (CharacterSet (..))
import qualified Dhall.Pretty
import           Dhall.Util         (_ERROR, renderExpression)
import           System.Directory
import           System.FilePath

-- | Create a package.dhall from files and directory contents.
-- For a description of how the package file is constructed see
-- 'getPackagePathAndContent'.
writePackage :: CharacterSet -> Maybe String -> NonEmpty FilePath -> IO ()
writePackage :: CharacterSet -> Maybe String -> NonEmpty String -> IO ()
writePackage CharacterSet
characterSet Maybe String
outputFn NonEmpty String
inputs = do
    (String
outputPath, Expr Src Import
expr) <- Maybe String -> NonEmpty String -> IO (String, Expr Src Import)
forall s.
Maybe String -> NonEmpty String -> IO (String, Expr s Import)
getPackagePathAndContent Maybe String
outputFn NonEmpty String
inputs
    CharacterSet -> Bool -> Maybe String -> Expr Src Import -> IO ()
forall a.
Pretty a =>
CharacterSet -> Bool -> Maybe String -> Expr Src a -> IO ()
renderExpression CharacterSet
characterSet Bool
True (String -> Maybe String
forall a. a -> Maybe a
Just String
outputPath) Expr Src Import
expr

-- | Get the path and the Dhall expression for a package file.
--
-- The location of the resulting package file is determined by the first path of the second argument:
--
--   * If it is a directory, it is also the output directory and the package
--     file will be placed there.
--
--   * If it is a file, then the directory that file resides in is the output
--     directory and the package file will be placed there.
--
-- All inputs provided as the second argument must be either in the output
-- directory or below it. They are processed depending on whether
-- the path points to a directory or a file:
--
--   * If the path points to a directory, all files with a @.dhall@ extensions
--     in that directory are included in the package.
--
--   * If the path points to a regular file, it is included in the package
--     unless it is the path of the package file itself.
--
getPackagePathAndContent :: Maybe String -> NonEmpty FilePath -> IO (FilePath, Expr s Import)
getPackagePathAndContent :: forall s.
Maybe String -> NonEmpty String -> IO (String, Expr s Import)
getPackagePathAndContent Maybe String
outputFn (String
path :| [String]
paths) = do
    String
outputDir <- do
        Bool
isDirectory <- String -> IO Bool
doesDirectoryExist String
path
        String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ if Bool
isDirectory then String
path else String -> String
takeDirectory String
path
    String
outputDir' <- String -> String
addTrailingPathSeparator (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
makeAbsolute (String -> String
normalise String
outputDir)

    -- Check if the supplied @dir@ argument points to a filesystem entry below
    -- the output directory and return the path relative to the output directory.
    let checkOutputDir :: String -> IO String
checkOutputDir String
dir = do
            String
absoluteDir <- String -> String
addTrailingPathSeparator (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
makeAbsolute (String -> String
normalise String
dir)
            let relativeDir :: String
relativeDir = String -> String -> String
makeRelative String
outputDir' String
absoluteDir
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
isRelative String
relativeDir) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                PackageError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (PackageError -> IO ()) -> PackageError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> PackageError
AmbiguousOutputDirectory String
outputDir String
dir
            String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
relativeDir

    Map Text (RecordField s Import)
resultMap <- Map Text (RecordField s Import)
-> (String -> IO String)
-> [String]
-> IO (Map Text (RecordField s Import))
forall s.
Map Text (RecordField s Import)
-> (String -> IO String)
-> [String]
-> IO (Map Text (RecordField s Import))
go Map Text (RecordField s Import)
forall k v. Ord k => Map k v
Map.empty String -> IO String
checkOutputDir (String
pathString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
paths)
    (String, Expr s Import) -> IO (String, Expr s Import)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
outputDir String -> String -> String
</> String
outputFn', Map Text (RecordField s Import) -> Expr s Import
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (Map Text (RecordField s Import) -> Expr s Import)
-> Map Text (RecordField s Import) -> Expr s Import
forall a b. (a -> b) -> a -> b
$ Map Text (RecordField s Import) -> Map Text (RecordField s Import)
forall k v. Map k v -> Map k v
Map.sort Map Text (RecordField s Import)
resultMap)
    where
        go :: Map Text (RecordField s Import) -> (FilePath -> IO FilePath) -> [FilePath] -> IO (Map Text (RecordField s Import))
        go :: forall s.
Map Text (RecordField s Import)
-> (String -> IO String)
-> [String]
-> IO (Map Text (RecordField s Import))
go !Map Text (RecordField s Import)
acc String -> IO String
_checkOutputDir [] = Map Text (RecordField s Import)
-> IO (Map Text (RecordField s Import))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text (RecordField s Import)
acc
        go !Map Text (RecordField s Import)
acc String -> IO String
checkOutputDir (String
p:[String]
ps) = do
            Bool
isDirectory <- String -> IO Bool
doesDirectoryExist String
p
            Bool
isFile <- String -> IO Bool
doesFileExist String
p
            if | Bool
isDirectory -> do
                    IO String -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO String -> IO ()) -> IO String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO String
checkOutputDir String
p
                    [String]
entries <- String -> IO [String]
listDirectory String
p
                    let entries' :: [String]
entries' = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
entry -> String -> String
takeExtension String
entry String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".dhall") [String]
entries
                    Map Text (RecordField s Import)
-> (String -> IO String)
-> [String]
-> IO (Map Text (RecordField s Import))
forall s.
Map Text (RecordField s Import)
-> (String -> IO String)
-> [String]
-> IO (Map Text (RecordField s Import))
go Map Text (RecordField s Import)
acc String -> IO String
checkOutputDir ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
p String -> String -> String
</>) [String]
entries' [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
ps)
               | Bool
isFile -> do
                    String
dir <- String -> IO String
checkOutputDir (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
p

                    let p' :: String
p' = String -> String
normalise (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String -> String
takeFileName String
p

                    let resultMap :: Map Text (RecordField s Import)
resultMap = if String
p' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
outputFn'
                            then Map Text (RecordField s Import)
forall k v. Ord k => Map k v
Map.empty
                            else String -> String -> Map Text (RecordField s Import)
forall s. String -> String -> Map Text (RecordField s Import)
filepathToMap String
outputFn' String
p'

                    Map Text (RecordField s Import)
acc' <- Map Text (RecordField s Import)
-> Map Text (RecordField s Import)
-> IO (Map Text (RecordField s Import))
forall s.
Map Text (RecordField s Import)
-> Map Text (RecordField s Import)
-> IO (Map Text (RecordField s Import))
mergeMaps Map Text (RecordField s Import)
acc Map Text (RecordField s Import)
forall {s}. Map Text (RecordField s Import)
resultMap
                    Map Text (RecordField s Import)
-> (String -> IO String)
-> [String]
-> IO (Map Text (RecordField s Import))
forall s.
Map Text (RecordField s Import)
-> (String -> IO String)
-> [String]
-> IO (Map Text (RecordField s Import))
go Map Text (RecordField s Import)
acc' String -> IO String
checkOutputDir [String]
ps
                | Bool
otherwise -> PackageError -> IO (Map Text (RecordField s Import))
forall e a. Exception e => e -> IO a
throwIO (PackageError -> IO (Map Text (RecordField s Import)))
-> PackageError -> IO (Map Text (RecordField s Import))
forall a b. (a -> b) -> a -> b
$ String -> PackageError
InvalidPath String
p

        outputFn' :: String
outputFn' = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"package.dhall" Maybe String
outputFn

-- | Construct a nested 'Map' from a 'FilePath'.
-- For example, the filepath @some/file/path.dhall@ will result in something
-- similar to the following:
--
-- fromList
--   [ ("some", fromList
--     [ ("file", fromList
--       [ ("path", ./some/file/path.dhall)
--       ])
--     ])
--   ])
--
-- ... where ./some/file/path.dhall is a Dhall import. If the last component
-- equals the value passed in the @outputFn@ argument we produce a slightly
-- different result. Consider for example the Dhall Prelude: We have some
-- sub-packages there like @List/package.dhall@. If we want to construct the
-- top-level @package.dhall@ we want an entry like
--
-- > List = ./List/package.dhall
--
-- in there and not:
--
-- > List = { package = ./List/package.dhall }
--
filepathToMap :: FilePath -> FilePath -> Map Text (RecordField s Import)
filepathToMap :: forall s. String -> String -> Map Text (RecordField s Import)
filepathToMap String
outputFn = [Text] -> [String] -> Map Text (RecordField s Import)
forall {s}. [Text] -> [String] -> Map Text (RecordField s Import)
go [] ([String] -> Map Text (RecordField s Import))
-> (String -> [String])
-> String
-> Map Text (RecordField s Import)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitDirectories
    where
        go :: [Text] -> [String] -> Map Text (RecordField s Import)
go [Text]
acc [] = [Text] -> [String] -> Map Text (RecordField s Import)
go [Text]
acc [String
"."]
        go ![Text]
acc [String
x] =
                    let import_ :: Import
import_ = Import
                            { importHashed :: ImportHashed
importHashed = ImportHashed
                                { hash :: Maybe SHA256Digest
hash = Maybe SHA256Digest
forall a. Maybe a
Nothing
                                , importType :: ImportType
importType = FilePrefix -> File -> ImportType
Local FilePrefix
Here File
                                    { directory :: Directory
directory = [Text] -> Directory
Directory [Text]
acc
                                    , file :: Text
file = String -> Text
Text.pack String
x
                                    }
                                }
                            , importMode :: ImportMode
importMode = ImportMode
Code
                            }
            in Text -> RecordField s Import -> Map Text (RecordField s Import)
forall k v. k -> v -> Map k v
Map.singleton (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
dropExtension String
x) (RecordField s Import -> Map Text (RecordField s Import))
-> RecordField s Import -> Map Text (RecordField s Import)
forall a b. (a -> b) -> a -> b
$ Expr s Import -> RecordField s Import
forall s a. Expr s a -> RecordField s a
makeRecordField (Expr s Import -> RecordField s Import)
-> Expr s Import -> RecordField s Import
forall a b. (a -> b) -> a -> b
$ Import -> Expr s Import
forall s a. a -> Expr s a
Embed Import
import_
        go ![Text]
acc [String
x, String
y] | String
y String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
outputFn =
                    let import_ :: Import
import_ = Import
                            { importHashed :: ImportHashed
importHashed = ImportHashed
                                { hash :: Maybe SHA256Digest
hash = Maybe SHA256Digest
forall a. Maybe a
Nothing
                                , importType :: ImportType
importType = FilePrefix -> File -> ImportType
Local FilePrefix
Here File
                                    { directory :: Directory
directory = [Text] -> Directory
Directory (String -> Text
Text.pack String
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc)
                                    , file :: Text
file = String -> Text
Text.pack String
y
                                    }
                                }
                            , importMode :: ImportMode
importMode = ImportMode
Code
                            }
            in Text -> RecordField s Import -> Map Text (RecordField s Import)
forall k v. k -> v -> Map k v
Map.singleton (String -> Text
Text.pack String
x) (RecordField s Import -> Map Text (RecordField s Import))
-> RecordField s Import -> Map Text (RecordField s Import)
forall a b. (a -> b) -> a -> b
$ Expr s Import -> RecordField s Import
forall s a. Expr s a -> RecordField s a
makeRecordField (Expr s Import -> RecordField s Import)
-> Expr s Import -> RecordField s Import
forall a b. (a -> b) -> a -> b
$ Import -> Expr s Import
forall s a. a -> Expr s a
Embed Import
import_
        go ![Text]
acc (String
x:[String]
xs) = Text -> RecordField s Import -> Map Text (RecordField s Import)
forall k v. k -> v -> Map k v
Map.singleton (String -> Text
Text.pack String
x) (RecordField s Import -> Map Text (RecordField s Import))
-> RecordField s Import -> Map Text (RecordField s Import)
forall a b. (a -> b) -> a -> b
$ Expr s Import -> RecordField s Import
forall s a. Expr s a -> RecordField s a
makeRecordField (Expr s Import -> RecordField s Import)
-> Expr s Import -> RecordField s Import
forall a b. (a -> b) -> a -> b
$ Map Text (RecordField s Import) -> Expr s Import
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (Map Text (RecordField s Import) -> Expr s Import)
-> Map Text (RecordField s Import) -> Expr s Import
forall a b. (a -> b) -> a -> b
$ [Text] -> [String] -> Map Text (RecordField s Import)
go (String -> Text
Text.pack String
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc) [String]
xs

-- | Merge two 'Map's constructed with 'filepathToMap'.
-- It will throw an error if the arguments are not compatible with each other, e.g.
-- we cannot merge the following two maps:
--
-- > fromList [ ("file", ./file.dhall) ]
-- > fromList [ ("file", fromList [("nested", ./file/nested.dhall)]) ]
--
mergeMaps :: Map Text (RecordField s Import) -> Map Text (RecordField s Import) -> IO (Map Text (RecordField s Import))
mergeMaps :: forall s.
Map Text (RecordField s Import)
-> Map Text (RecordField s Import)
-> IO (Map Text (RecordField s Import))
mergeMaps Map Text (RecordField s Import)
x Map Text (RecordField s Import)
y = do
    let x' :: Map Text (NonEmpty (RecordField s Import))
x' = (RecordField s Import -> NonEmpty (RecordField s Import))
-> Map Text (RecordField s Import)
-> Map Text (NonEmpty (RecordField s Import))
forall a b. (a -> b) -> Map Text a -> Map Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RecordField s Import
-> [RecordField s Import] -> NonEmpty (RecordField s Import)
forall a. a -> [a] -> NonEmpty a
:| []) Map Text (RecordField s Import)
x
        y' :: Map Text (NonEmpty (RecordField s Import))
y' = (RecordField s Import -> NonEmpty (RecordField s Import))
-> Map Text (RecordField s Import)
-> Map Text (NonEmpty (RecordField s Import))
forall a b. (a -> b) -> Map Text a -> Map Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RecordField s Import
-> [RecordField s Import] -> NonEmpty (RecordField s Import)
forall a. a -> [a] -> NonEmpty a
:| []) Map Text (RecordField s Import)
y
        z :: Map Text (NonEmpty (RecordField s Import))
z = (NonEmpty (RecordField s Import)
 -> NonEmpty (RecordField s Import)
 -> NonEmpty (RecordField s Import))
-> Map Text (NonEmpty (RecordField s Import))
-> Map Text (NonEmpty (RecordField s Import))
-> Map Text (NonEmpty (RecordField s Import))
forall k v. Ord k => (v -> v -> v) -> Map k v -> Map k v -> Map k v
Map.unionWith NonEmpty (RecordField s Import)
-> NonEmpty (RecordField s Import)
-> NonEmpty (RecordField s Import)
forall a. Semigroup a => a -> a -> a
(<>) Map Text (NonEmpty (RecordField s Import))
x' Map Text (NonEmpty (RecordField s Import))
y'
    Map Text (NonEmpty (RecordField s Import))
-> (NonEmpty (RecordField s Import) -> IO (RecordField s Import))
-> IO (Map Text (RecordField s Import))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Map Text (NonEmpty (RecordField s Import))
z ((NonEmpty (RecordField s Import) -> IO (RecordField s Import))
 -> IO (Map Text (RecordField s Import)))
-> (NonEmpty (RecordField s Import) -> IO (RecordField s Import))
-> IO (Map Text (RecordField s Import))
forall a b. (a -> b) -> a -> b
$ \case
        v :: RecordField s Import
v@RecordField{recordFieldValue :: forall s a. RecordField s a -> Expr s a
recordFieldValue = Embed{}} :| [] -> RecordField s Import -> IO (RecordField s Import)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RecordField s Import
v
        NonEmpty (RecordField s Import)
vs | Just NonEmpty (Map Text (RecordField s Import))
rs <- (RecordField s Import -> Maybe (Map Text (RecordField s Import)))
-> NonEmpty (RecordField s Import)
-> Maybe (NonEmpty (Map Text (RecordField s Import)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse RecordField s Import -> Maybe (Map Text (RecordField s Import))
forall s.
RecordField s Import -> Maybe (Map Text (RecordField s Import))
extractRecordLit NonEmpty (RecordField s Import)
vs -> Expr s Import -> RecordField s Import
forall s a. Expr s a -> RecordField s a
makeRecordField (Expr s Import -> RecordField s Import)
-> (Map Text (RecordField s Import) -> Expr s Import)
-> Map Text (RecordField s Import)
-> RecordField s Import
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text (RecordField s Import) -> Expr s Import
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (Map Text (RecordField s Import) -> Expr s Import)
-> (Map Text (RecordField s Import)
    -> Map Text (RecordField s Import))
-> Map Text (RecordField s Import)
-> Expr s Import
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text (RecordField s Import) -> Map Text (RecordField s Import)
forall k v. Map k v -> Map k v
Map.sort (Map Text (RecordField s Import) -> RecordField s Import)
-> IO (Map Text (RecordField s Import))
-> IO (RecordField s Import)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map Text (RecordField s Import)
 -> Map Text (RecordField s Import)
 -> IO (Map Text (RecordField s Import)))
-> Map Text (RecordField s Import)
-> NonEmpty (Map Text (RecordField s Import))
-> IO (Map Text (RecordField s Import))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map Text (RecordField s Import)
-> Map Text (RecordField s Import)
-> IO (Map Text (RecordField s Import))
forall s.
Map Text (RecordField s Import)
-> Map Text (RecordField s Import)
-> IO (Map Text (RecordField s Import))
mergeMaps Map Text (RecordField s Import)
forall k v. Ord k => Map k v
Map.empty NonEmpty (Map Text (RecordField s Import))
rs
           | Bool
otherwise -> PackageError -> IO (RecordField s Import)
forall e a. Exception e => e -> IO a
throwIO (PackageError -> IO (RecordField s Import))
-> PackageError -> IO (RecordField s Import)
forall a b. (a -> b) -> a -> b
$ [Import] -> PackageError
IncompatiblePaths ([Import] -> PackageError) -> [Import] -> PackageError
forall a b. (a -> b) -> a -> b
$ (RecordField s Import -> [Import])
-> NonEmpty (RecordField s Import) -> [Import]
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap RecordField s Import -> [Import]
forall s. RecordField s Import -> [Import]
extractEmbeds NonEmpty (RecordField s Import)
vs
    where
        extractEmbeds :: RecordField s Import -> [Import]
        extractEmbeds :: forall s. RecordField s Import -> [Import]
extractEmbeds RecordField{recordFieldValue :: forall s a. RecordField s a -> Expr s a
recordFieldValue = Embed Import
import_} = [Import
import_]
        extractEmbeds RecordField{recordFieldValue :: forall s a. RecordField s a -> Expr s a
recordFieldValue = RecordLit Map Text (RecordField s Import)
xs} = (RecordField s Import -> [Import])
-> Map Text (RecordField s Import) -> [Import]
forall m a. Monoid m => (a -> m) -> Map Text a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap RecordField s Import -> [Import]
forall s. RecordField s Import -> [Import]
extractEmbeds Map Text (RecordField s Import)
xs
        extractEmbeds RecordField s Import
_ = [Import]
forall a. Monoid a => a
mempty

        extractRecordLit :: RecordField s Import -> Maybe (Map Text (RecordField s Import))
        extractRecordLit :: forall s.
RecordField s Import -> Maybe (Map Text (RecordField s Import))
extractRecordLit RecordField{recordFieldValue :: forall s a. RecordField s a -> Expr s a
recordFieldValue = RecordLit Map Text (RecordField s Import)
xs} = Map Text (RecordField s Import)
-> Maybe (Map Text (RecordField s Import))
forall a. a -> Maybe a
Just Map Text (RecordField s Import)
xs
        extractRecordLit RecordField s Import
_ = Maybe (Map Text (RecordField s Import))
forall a. Maybe a
Nothing

-- | Exception thrown when creating a package file.
data PackageError
    = AmbiguousOutputDirectory FilePath FilePath
    | IncompatiblePaths [Import]
    | InvalidPath FilePath

instance Exception PackageError

instance Show PackageError where
    show :: PackageError -> String
show (AmbiguousOutputDirectory String
dir1 String
dir2) =
        String
forall string. IsString string => string
_ERROR String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": ❰dhall package❱ failed because the inputs make it impossible to\n\
        \determine the output directory of the package file. You asked to include files\n\
        \from the following directories in the package:\n\
        \\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
dir1 String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
        String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
dir2 String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
        String
"\n\n\
        \Although those paths might point to the same location they are not lexically the\n\
        \same."

    show (IncompatiblePaths [Import]
imports) =
        String
forall string. IsString string => string
_ERROR String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": ❰dhall package❱ failed because some inputs are not compatible with\n\
        \each other:\n\
        \\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
unlines ((Import -> String) -> [Import] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Doc Ann -> String
forall a. Show a => a -> String
show (Doc Ann -> String) -> (Import -> Doc Ann) -> Import -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr Any Import -> Doc Ann
forall a s. Pretty a => Expr s a -> Doc Ann
Dhall.Pretty.prettyExpr (Expr Any Import -> Doc Ann)
-> (Import -> Expr Any Import) -> Import -> Doc Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Import -> Expr Any Import
forall s a. a -> Expr s a
Embed) [Import]
imports)

    show (InvalidPath String
fp) =
        String
forall string. IsString string => string
_ERROR String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": ❰dhall package❱ failed because the input does not exist or is\n\
        \neither a directory nor a regular file:\n\
        \\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fp