module Text.EDE.Internal.Filters where
import Control.Applicative
import Data.Aeson (Value(..), Array, Object, encode)
import qualified Data.Char as Char
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as Map
import Data.Maybe
import Data.Monoid
import Data.Scientific (Scientific)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LText
import qualified Data.Text.Lazy.Encoding as LText
import Data.Text.Manipulate
import qualified Data.Text.Unsafe as Text
import qualified Data.Vector as Vector
import Text.EDE.Internal.Quoting
import Text.EDE.Internal.Types
import Text.PrettyPrint.ANSI.Leijen (Pretty(..), (<+>))
default (Integer)
stdlib :: HashMap Text Term
stdlib = Map.fromList
[ "!" @: not
, "&&" @: (&&)
, "||" @: (||)
, "==" `qpoly2` (==)
, "!=" `qpoly2` (/=)
, ">" `qnum2` (>)
, ">=" `qnum2` (>=)
, "<=" `qnum2` (<=)
, "<" `qnum2` (<)
, "+" `qnum2` (+)
, "-" `qnum2` ()
, "*" `qnum2` (*)
, "abs" `qnum1` abs
, "signum" `qnum1` signum
, "negate" `qnum1` negate
, "truncate" `qnum1` (fromIntegral . truncate)
, "round" `qnum1` (fromIntegral . round)
, "ceiling" `qnum1` (fromIntegral . ceiling)
, "floor" `qnum1` (fromIntegral . floor)
, "lowerHead" @: lowerHead
, "upperHead" @: upperHead
, "toTitle" @: toTitle
, "toCamel" @: toCamel
, "toPascal" @: toPascal
, "toSnake" @: toSnake
, "toSpinal" @: toSpinal
, "toTrain" @: toTrain
, "toUpper" @: Text.toUpper
, "toLower" @: Text.toLower
, "toOrdinal" @: (toOrdinal :: Integer -> Text)
, "dropLower" @: Text.dropWhile (not . Char.isUpper)
, "dropUpper" @: Text.dropWhile (not . Char.isLower)
, "takeWord" @: takeWord
, "dropWord" @: dropWord
, "splitWords" @: splitWords
, "strip" @: Text.strip
, "stripPrefix" @: (\x p -> fromMaybe x (p `Text.stripPrefix` x))
, "stripSuffix" @: (\x s -> fromMaybe x (s `Text.stripSuffix` x))
, "stripStart" @: Text.stripStart
, "stripEnd" @: Text.stripEnd
, "replace" @: flip Text.replace
, "remove" @: (\x r -> Text.replace r "" x)
, "toEllipsis" @: flip toEllipsis
, "toEllipsisWith" @: (\x n e -> toEllipsisWith n e x)
, "indentLines" @: flip indentLines
, "prependLines" @: flip prependLines
, "justifyLeft" @: (\x n -> Text.justifyLeft n ' ' x)
, "justifyRight" @: (\x n -> Text.justifyRight n ' ' x)
, "center" @: (\x n -> Text.center n ' ' x)
, qcol1 "length" Text.length Map.size Vector.length
, qcol1 "empty" Text.null Map.null Vector.null
, qcol1 "reverse" Text.reverse id Vector.reverse
, qlist1 "head" headT headV
, qlist1 "last" lastT lastV
, qlist1 "tail" lastT tailV
, qlist1 "init" initT initV
, "keys" @: (Map.keys :: Object -> [Text])
, "elems" @: (Map.elems :: Object -> [Value])
, "show" @: (LText.decodeUtf8 . encode :: Value -> LText.Text)
]
(@:) :: Quote a => Id -> a -> (Id, Term)
k @: q = (k, quote k 0 q)
qpoly2 :: Quote a => Id -> (Value -> Value -> a) -> (Id, Term)
qpoly2 k = (k,) . quote k 0
qnum1 :: Id -> (Scientific -> Scientific) -> (Id, Term)
qnum1 k = (k,) . quote k 0
qnum2 :: Quote a => Id -> (Scientific -> Scientific -> a) -> (Id, Term)
qnum2 k = (k,) . quote k 0
qlist1 :: (Quote a, Quote b)
=> Id
-> (Text -> a)
-> (Array -> b)
-> (Id, Term)
qlist1 k f g = (k,) . TLam $ \case
TVal (String t) -> pure . quote k 0 $ f t
TVal (Array v) -> pure . quote k 0 $ g v
x -> Failure $
"when expecting a String or Array, encountered" <+> pretty x
qcol1 :: (Quote a, Quote b, Quote c)
=> Id
-> (Text -> a)
-> (Object -> b)
-> (Array -> c)
-> (Id, Term)
qcol1 k f g h = (k,) . TLam $ \case
TVal (String t) -> pure . quote k 0 $ f t
TVal (Object o) -> pure . quote k 0 $ g o
TVal (Array v) -> pure . quote k 0 $ h v
x -> Failure $
"when expecting a String, Object, or Array, encountered" <+> pretty x
headT, lastT, tailT, initT :: Text -> Value
headT = text (Text.singleton . Text.unsafeHead)
lastT = text (Text.singleton . Text.last)
tailT = text Text.unsafeTail
initT = text Text.init
headV, lastV, tailV, initV :: Array -> Value
headV = vec Vector.unsafeHead
lastV = vec Vector.unsafeLast
tailV = vec (Array . Vector.unsafeTail)
initV = vec (Array . Vector.unsafeInit)
text :: (Text -> Text) -> Text -> Value
text f = String . safe mempty Text.null f
vec :: (Array -> Value) -> Array -> Value
vec = safe (Array Vector.empty) Vector.null
safe :: b -> (a -> Bool) -> (a -> b) -> a -> b
safe v f g x
| f x = v
| otherwise = g x