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

{-# OPTIONS_GHC -Wno-orphans #-}

module Dhall.Syntax.Instances.Pretty
    ( pathCharacter
    ) where

import                Data.Text             (Text)
import {-# SOURCE #-} Dhall.Pretty.Internal
import                Dhall.Syntax.Const
import                Dhall.Syntax.Expr
import                Dhall.Syntax.Import
import                Dhall.Syntax.Var
import                Prettyprinter         (Doc, Pretty)

import qualified Data.Text
import qualified Network.URI   as URI
import qualified Prettyprinter as Pretty

instance Pretty Const where
    pretty :: forall ann. Const -> Doc ann
pretty = Doc Ann -> Doc ann
forall ann xxx. Doc ann -> Doc xxx
Pretty.unAnnotate (Doc Ann -> Doc ann) -> (Const -> Doc Ann) -> Const -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> Doc Ann
prettyConst

instance Pretty Var where
    pretty :: forall ann. Var -> Doc ann
pretty = Doc Ann -> Doc ann
forall ann xxx. Doc ann -> Doc xxx
Pretty.unAnnotate (Doc Ann -> Doc ann) -> (Var -> Doc Ann) -> Var -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var -> Doc Ann
prettyVar

-- | Generates a syntactically valid Dhall program
instance Pretty a => Pretty (Expr s a) where
    pretty :: forall ann. Expr s a -> Doc ann
pretty = Doc Ann -> Doc ann
forall ann xxx. Doc ann -> Doc xxx
Pretty.unAnnotate (Doc Ann -> Doc ann)
-> (Expr s a -> Doc Ann) -> Expr s a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr s a -> Doc Ann
forall a s. Pretty a => Expr s a -> Doc Ann
prettyExpr

instance Pretty Directory where
    pretty :: forall ann. Directory -> Doc ann
pretty (Directory {[Text]
components :: [Text]
components :: Directory -> [Text]
..}) = (Text -> Doc ann) -> [Text] -> Doc ann
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Doc ann
forall ann. Text -> Doc ann
prettyPathComponent ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
components)

prettyPathComponent :: Text -> Doc ann
prettyPathComponent :: forall ann. Text -> Doc ann
prettyPathComponent Text
text
    | (Char -> Bool) -> Text -> Bool
Data.Text.all Char -> Bool
pathCharacter Text
text =
        Doc ann
"/" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
text
    | Bool
otherwise =
        Doc ann
"/\"" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
text Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\""

instance Pretty File where
    pretty :: forall ann. File -> Doc ann
pretty (File {Text
Directory
directory :: Directory
file :: Text
directory :: File -> Directory
file :: File -> Text
..}) =
            Directory -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Directory -> Doc ann
Pretty.pretty Directory
directory
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>  Text -> Doc ann
forall ann. Text -> Doc ann
prettyPathComponent Text
file

instance Pretty FilePrefix where
    pretty :: forall ann. FilePrefix -> Doc ann
pretty FilePrefix
Absolute = Doc ann
""
    pretty FilePrefix
Here     = Doc ann
"."
    pretty FilePrefix
Parent   = Doc ann
".."
    pretty FilePrefix
Home     = Doc ann
"~"

instance Pretty URL where
    pretty :: forall ann. URL -> Doc ann
pretty (URL {Maybe Text
Maybe (Expr Src Import)
Text
Scheme
File
scheme :: Scheme
authority :: Text
path :: File
query :: Maybe Text
headers :: Maybe (Expr Src Import)
scheme :: URL -> Scheme
authority :: URL -> Text
path :: URL -> File
query :: URL -> Maybe Text
headers :: URL -> Maybe (Expr Src Import)
..}) =
            Doc ann
schemeDoc
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>  Doc ann
"://"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>  Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
authority
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>  Doc ann
forall {ann}. Doc ann
pathDoc
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>  Doc ann
forall {ann}. Doc ann
queryDoc
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>  (Expr Src Import -> Doc ann) -> Maybe (Expr Src Import) -> Doc ann
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Expr Src Import -> Doc ann
forall {a} {xxx}. Pretty a => a -> Doc xxx
prettyHeaders Maybe (Expr Src Import)
headers
      where
        prettyHeaders :: a -> Doc xxx
prettyHeaders a
h =
          Doc xxx
" using (" Doc xxx -> Doc xxx -> Doc xxx
forall a. Semigroup a => a -> a -> a
<> Doc Any -> Doc xxx
forall ann xxx. Doc ann -> Doc xxx
Pretty.unAnnotate (a -> Doc Any
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty a
h) Doc xxx -> Doc xxx -> Doc xxx
forall a. Semigroup a => a -> a -> a
<> Doc xxx
")"

        File {Text
Directory
directory :: File -> Directory
file :: File -> Text
directory :: Directory
file :: Text
..} = File
path

        Directory {[Text]
components :: Directory -> [Text]
components :: [Text]
..} = Directory
directory

        pathDoc :: Doc ann
pathDoc =
                (Text -> Doc ann) -> [Text] -> Doc ann
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Doc ann
forall ann. Text -> Doc ann
prettyURIComponent ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
components)
            Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>  Text -> Doc ann
forall ann. Text -> Doc ann
prettyURIComponent Text
file

        schemeDoc :: Doc ann
schemeDoc = case Scheme
scheme of
            Scheme
HTTP  -> Doc ann
"http"
            Scheme
HTTPS -> Doc ann
"https"

        queryDoc :: Doc ann
queryDoc = case Maybe Text
query of
            Maybe Text
Nothing -> Doc ann
""
            Just Text
q  -> Doc ann
"?" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
q

prettyURIComponent :: Text -> Doc ann
prettyURIComponent :: forall ann. Text -> Doc ann
prettyURIComponent Text
text =
        String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (String -> Doc ann) -> String -> Doc ann
forall a b. (a -> b) -> a -> b
$ String -> String
URI.normalizeCase (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
URI.normalizeEscape (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Data.Text.unpack Text
text

instance Pretty ImportType where
    pretty :: forall ann. ImportType -> Doc ann
pretty (Local FilePrefix
prefix File
file) =
        FilePrefix -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. FilePrefix -> Doc ann
Pretty.pretty FilePrefix
prefix Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> File -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. File -> Doc ann
Pretty.pretty File
file

    pretty (Remote URL
url) = URL -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. URL -> Doc ann
Pretty.pretty URL
url

    pretty (Env Text
env) = Doc ann
"env:" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
prettyEnvironmentVariable Text
env

    pretty ImportType
Missing = Doc ann
"missing"

instance Pretty ImportHashed where
    pretty :: forall ann. ImportHashed -> Doc ann
pretty (ImportHashed  Maybe SHA256Digest
Nothing ImportType
p) =
      ImportType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ImportType -> Doc ann
Pretty.pretty ImportType
p
    pretty (ImportHashed (Just SHA256Digest
h) ImportType
p) =
      Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
Pretty.group (Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt Doc ann
forall {ann}. Doc ann
long Doc ann
forall {ann}. Doc ann
short)
      where
        long :: Doc ann
long =
            Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
Pretty.align
                (   ImportType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ImportType -> Doc ann
Pretty.pretty ImportType
p Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall {ann}. Doc ann
Pretty.hardline
                Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>  Doc ann
"  sha256:" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (SHA256Digest -> String
forall a. Show a => a -> String
show SHA256Digest
h)
                )

        short :: Doc ann
short = ImportType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ImportType -> Doc ann
Pretty.pretty ImportType
p Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" sha256:" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (SHA256Digest -> String
forall a. Show a => a -> String
show SHA256Digest
h)

instance Pretty Import where
    pretty :: forall ann. Import -> Doc ann
pretty (Import {ImportHashed
ImportMode
importHashed :: ImportHashed
importMode :: ImportMode
importHashed :: Import -> ImportHashed
importMode :: Import -> ImportMode
..}) = ImportHashed -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ImportHashed -> Doc ann
Pretty.pretty ImportHashed
importHashed Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
suffix
      where
        suffix :: Text
        suffix :: Text
suffix = case ImportMode
importMode of
            ImportMode
RawText  -> Text
" as Text"
            ImportMode
Location -> Text
" as Location"
            ImportMode
Code     -> Text
""
            ImportMode
RawBytes -> Text
" as Bytes"

{-| Returns `True` if the given `Char` is valid within an unquoted path
    component

    This is exported for reuse within the @"Dhall.Parser.Token"@ module
-}
pathCharacter :: Char -> Bool
pathCharacter :: Char -> Bool
pathCharacter Char
c =
         Char
'\x21' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c
    Bool -> Bool -> Bool
||  (Char
'\x24' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x27')
    Bool -> Bool -> Bool
||  (Char
'\x2A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2B')
    Bool -> Bool -> Bool
||  (Char
'\x2D' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2E')
    Bool -> Bool -> Bool
||  (Char
'\x30' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x3B')
    Bool -> Bool -> Bool
||  Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x3D'
    Bool -> Bool -> Bool
||  (Char
'\x40' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x5A')
    Bool -> Bool -> Bool
||  (Char
'\x5E' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x7A')
    Bool -> Bool -> Bool
||  Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x7C'
    Bool -> Bool -> Bool
||  Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x7E'