{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
module Language.REST.Types (
prettyPrint
, PPArgs(..)
, Relation(..)
, toOrderedSet
) where
import GHC.Generics (Generic)
import Prelude hiding (GT, EQ)
import Data.Hashable
import qualified Data.List as L
import qualified Data.HashSet as S
import qualified Data.Set as OS
import qualified Data.Text as T
import Text.Printf
import Language.REST.Op
import Language.REST.MetaTerm as MT
data PPArgs = PPArgs
{
PPArgs -> [(Text, Text)]
ppReplace :: [(T.Text, T.Text)]
, PPArgs -> [(Text, Text)]
ppInfixOps :: [(T.Text, T.Text)]
, PPArgs -> MetaTerm -> Maybe Text
ppCustom :: MetaTerm -> Maybe T.Text
}
prettyPrint :: ToMetaTerm a => PPArgs -> a -> String
prettyPrint :: forall a. ToMetaTerm a => PPArgs -> a -> String
prettyPrint (PPArgs [(Text, Text)]
substs [(Text, Text)]
infixOps MetaTerm -> Maybe Text
custom) a
t = Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ MetaTerm -> Text
go forall a b. (a -> b) -> a -> b
$ MetaTerm -> MetaTerm
replaceAll forall a b. (a -> b) -> a -> b
$ forall a. ToMetaTerm a => a -> MetaTerm
toMetaTerm a
t where
replace :: Text -> Text
replace Text
s | Just (Text
from, Text
to) <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((Text -> Text -> Bool
`T.isPrefixOf` Text
s) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Text, Text)]
substs
= Text -> Text -> Text
T.append Text
to forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop (Text -> Int
T.length Text
from) Text
s
replace Text
s = Text
s
replaceAll :: MT.MetaTerm -> MT.MetaTerm
replaceAll :: MetaTerm -> MetaTerm
replaceAll (MT.Var String
x) = String -> MetaTerm
MT.Var String
x
replaceAll (MT.RWApp (Op Text
op) [MetaTerm]
ts) = Op -> [MetaTerm] -> MetaTerm
MT.RWApp (Text -> Op
Op (Text -> Text
replace Text
op)) (forall a b. (a -> b) -> [a] -> [b]
map MetaTerm -> MetaTerm
replaceAll [MetaTerm]
ts)
go :: MT.MetaTerm -> T.Text
go :: MetaTerm -> Text
go (MT.Var String
x) = String -> Text
T.pack String
x
go MetaTerm
mt | Just Text
s <- MetaTerm -> Maybe Text
custom MetaTerm
mt = Text
s
go (MT.RWApp (Op Text
op) [MetaTerm
t1, MetaTerm
t2]) | Just Text
op' <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup Text
op [(Text, Text)]
infixOps
= String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"%s %s %s" (MetaTerm -> Text
goParens MetaTerm
t1) Text
op' (MetaTerm -> Text
goParens MetaTerm
t2)
go (MT.RWApp (Op Text
op) []) = Text
op
go (MT.RWApp (Op Text
op) [MetaTerm]
xs) = [Text] -> Text
T.concat [Text
op, Text
"(" , Text -> [Text] -> Text
T.intercalate Text
", " (forall a b. (a -> b) -> [a] -> [b]
map MetaTerm -> Text
go [MetaTerm]
xs) , Text
")"]
goParens :: MetaTerm -> Text
goParens MetaTerm
mt | MetaTerm -> Bool
needsParens MetaTerm
mt = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"(%s)" (MetaTerm -> Text
go MetaTerm
mt)
goParens MetaTerm
mt = MetaTerm -> Text
go MetaTerm
mt
needsParens :: MetaTerm -> Bool
needsParens (MT.RWApp (Op Text
op) [MetaTerm]
_) = Text
op forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Text, Text)]
infixOps
needsParens MetaTerm
_ = Bool
False
data Relation = GT | GTE | EQ deriving (Relation -> Relation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relation -> Relation -> Bool
$c/= :: Relation -> Relation -> Bool
== :: Relation -> Relation -> Bool
$c== :: Relation -> Relation -> Bool
Eq, forall x. Rep Relation x -> Relation
forall x. Relation -> Rep Relation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Relation x -> Relation
$cfrom :: forall x. Relation -> Rep Relation x
Generic, Eq Relation
Int -> Relation -> Int
Relation -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Relation -> Int
$chash :: Relation -> Int
hashWithSalt :: Int -> Relation -> Int
$chashWithSalt :: Int -> Relation -> Int
Hashable)
instance Show Relation where
show :: Relation -> String
show Relation
GT = String
">"
show Relation
GTE = String
"≥"
show Relation
EQ = String
"≅"
toOrderedSet :: (Eq a, Hashable a, Ord a) => S.HashSet a -> OS.Set a
toOrderedSet :: forall a. (Eq a, Hashable a, Ord a) => HashSet a -> Set a
toOrderedSet = forall a. Ord a => [a] -> Set a
OS.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashSet a -> [a]
S.toList