{-# 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 = forall ann xxx. Doc ann -> Doc xxx
Pretty.unAnnotate 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 = forall ann xxx. Doc ann -> Doc xxx
Pretty.unAnnotate 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 = forall ann xxx. Doc ann -> Doc xxx
Pretty.unAnnotate forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: Directory -> [Text]
components :: [Text]
..}) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall ann. Text -> Doc ann
prettyPathComponent (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
"/" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
text
    | Bool
otherwise =
        Doc ann
"/\"" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
Pretty.pretty Text
text forall a. Semigroup a => a -> a -> a
<> Doc ann
"\""

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

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

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

        pathDoc :: Doc ann
pathDoc =
                forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall ann. Text -> Doc ann
prettyURIComponent (forall a. [a] -> [a]
reverse [Text]
components)
            forall a. Semigroup a => a -> a -> a
<>  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
"?" forall a. Semigroup a => a -> a -> a
<> 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 =
        forall a ann. Pretty a => a -> Doc ann
Pretty.pretty forall a b. (a -> b) -> a -> b
$ String -> String
URI.normalizeCase forall a b. (a -> b) -> a -> b
$ String -> String
URI.normalizeEscape forall a b. (a -> b) -> a -> b
$ 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) =
        forall a ann. Pretty a => a -> Doc ann
Pretty.pretty FilePrefix
prefix forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
Pretty.pretty File
file

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

    pretty (Env Text
env) = Doc ann
"env:" forall a. Semigroup a => a -> a -> a
<> 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) =
      forall a ann. Pretty a => a -> Doc ann
Pretty.pretty ImportType
p
    pretty (ImportHashed (Just SHA256Digest
h) ImportType
p) =
      forall ann. Doc ann -> Doc ann
Pretty.group (forall ann. Doc ann -> Doc ann -> Doc ann
Pretty.flatAlt forall {ann}. Doc ann
long forall {ann}. Doc ann
short)
      where
        long :: Doc ann
long =
            forall ann. Doc ann -> Doc ann
Pretty.align
                (   forall a ann. Pretty a => a -> Doc ann
Pretty.pretty ImportType
p forall a. Semigroup a => a -> a -> a
<> forall {ann}. Doc ann
Pretty.hardline
                forall a. Semigroup a => a -> a -> a
<>  Doc ann
"  sha256:" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
Pretty.pretty (forall a. Show a => a -> String
show SHA256Digest
h)
                )

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

instance Pretty Import where
    pretty :: forall ann. Import -> Doc ann
pretty (Import {ImportHashed
ImportMode
importMode :: Import -> ImportMode
importHashed :: Import -> ImportHashed
importMode :: ImportMode
importHashed :: ImportHashed
..}) = forall a ann. Pretty a => a -> Doc ann
Pretty.pretty ImportHashed
importHashed forall a. Semigroup a => a -> a -> a
<> 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' forall a. Eq a => a -> a -> Bool
== Char
c
    Bool -> Bool -> Bool
||  (Char
'\x24' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x27')
    Bool -> Bool -> Bool
||  (Char
'\x2A' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x2B')
    Bool -> Bool -> Bool
||  (Char
'\x2D' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x2E')
    Bool -> Bool -> Bool
||  (Char
'\x30' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x3B')
    Bool -> Bool -> Bool
||  Char
c forall a. Eq a => a -> a -> Bool
== Char
'\x3D'
    Bool -> Bool -> Bool
||  (Char
'\x40' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x5A')
    Bool -> Bool -> Bool
||  (Char
'\x5E' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\x7A')
    Bool -> Bool -> Bool
||  Char
c forall a. Eq a => a -> a -> Bool
== Char
'\x7C'
    Bool -> Bool -> Bool
||  Char
c forall a. Eq a => a -> a -> Bool
== Char
'\x7E'