typst 0.1.0.0 → 0.2.0.0
raw patch · 9 files changed
+253/−21 lines, 9 filesdep +digitsdep +timedep ~typst-symbols
Dependencies added: digits, time
Dependency ranges changed: typst-symbols
Files
- app/Main.hs +2/−1
- src/Typst/Evaluate.hs +6/−2
- src/Typst/Methods.hs +156/−2
- src/Typst/Module/Calc.hs +2/−6
- src/Typst/Module/Math.hs +4/−0
- src/Typst/Module/Standard.hs +61/−2
- src/Typst/Types.hs +12/−3
- test/Main.hs +2/−1
- typst.cabal +8/−4
app/Main.hs view
@@ -15,6 +15,7 @@ import Text.Show.Pretty (pPrint) import Typst (evaluateTypst, parseTypst) import Typst.Types (Val (..), repr)+import Data.Time (getCurrentTime) data Opts = Opts { optShowParse :: Bool,@@ -69,7 +70,7 @@ when (optShowParse opts || showAll) $ do when showAll $ putStrLn "--- parse tree ---" pPrint parseResult- result <- evaluateTypst BS.readFile "stdin" parseResult+ result <- evaluateTypst BS.readFile getCurrentTime "stdin" parseResult case result of Left e -> err $ show e Right cs -> do
src/Typst/Evaluate.hs view
@@ -36,6 +36,7 @@ import Typst.Syntax import Typst.Types import Typst.Util (makeFunction, nthArg)+import Data.Time (UTCTime) -- import Debug.Trace @@ -45,15 +46,18 @@ Monad m => -- | Function to read a file (FilePath -> m BS.ByteString) ->+ -- | Function to get current UTCTime+ m UTCTime -> -- | Path of parsed content FilePath -> -- | Markup produced by 'parseTypst' [Markup] -> m (Either ParseError (Seq Content))-evaluateTypst loadBytes =+evaluateTypst loadBytes currentUTCTime = runParserT (mconcat <$> many pContent <* eof)- initialEvalState {evalLoadBytes = loadBytes}+ initialEvalState { evalLoadBytes = loadBytes+ , evalCurrentUTCTime = currentUTCTime} initialEvalState :: EvalState m initialEvalState =
src/Typst/Methods.hs view
@@ -12,7 +12,7 @@ ) where -import Control.Monad (MonadPlus (mplus), foldM)+import Control.Monad (MonadPlus (mplus), foldM, void) import Control.Monad.Reader (MonadReader (ask), MonadTrans (lift)) import qualified Data.Array as Array import qualified Data.Foldable as F@@ -23,7 +23,8 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Vector as V-import Text.Parsec (getState, runParserT, updateState)+import Text.Parsec+import Text.Parsec.String (Parser) import Typst.Module.Standard (standardModule) import Typst.Regex ( RE (..),@@ -37,6 +38,7 @@ ) import Typst.Types import Typst.Util (allArgs, makeFunction, namedArg, nthArg)+import Data.Time (toGregorian, dayOfWeek, formatTime, defaultTimeLocale, UTCTime(..)) -- import Debug.Trace @@ -351,6 +353,11 @@ [Elt _ _ fields] | Just x <- M.lookup "text" fields -> pure x _ -> fail "Content is not a single text element"+ "fields" -> pure $ makeFunction $ do+ VDict <$>+ case F.toList cs of+ (Elt _ _ fields:_) -> pure $ OM.fromList $ M.toList fields+ _ -> pure OM.empty _ -> let childrenOrFallback = if fld == "children"@@ -613,6 +620,53 @@ "pos" -> pure $ makeFunction $ pure $ VArray $ V.fromList (positional args) "named" -> pure $ makeFunction $ pure $ VDict $ named args _ -> noMethod "Arguments" fld+ VDateTime mbdate mbtime -> do+ let toSeconds = (floor :: Double -> Integer) . realToFrac+ case fld of+ "year" -> pure $ makeFunction $+ pure $ case toGregorian <$> mbdate of+ Nothing -> VNone+ Just (y,_,_) -> VInteger (fromIntegral y)+ "month" -> pure $ makeFunction $+ pure $ case toGregorian <$> mbdate of+ Nothing -> VNone+ Just (_,m,_) -> VInteger (fromIntegral m)+ "day" -> pure $ makeFunction $+ pure $ case toGregorian <$> mbdate of+ Nothing -> VNone+ Just (_,_,d) -> VInteger (fromIntegral d)+ "weekday" -> pure $ makeFunction $+ pure $ case dayOfWeek <$> mbdate of+ Nothing -> VNone+ Just d-> VInteger (fromIntegral $ fromEnum d)+ "hour" -> pure $ makeFunction $+ pure $ case toSeconds <$> mbtime of+ Nothing -> VNone+ Just t -> VInteger $ t `div` 3600+ "minute" -> pure $ makeFunction $+ pure $ case toSeconds <$> mbtime of+ Nothing -> VNone+ Just t -> VInteger $ (t `mod` 3600) `div` 60+ "second" -> pure $ makeFunction $+ pure $ case toSeconds <$> mbtime of+ Nothing -> VNone+ Just t -> VInteger $ t `mod` 60+ "display" -> pure $ makeFunction $ do+ mbfmt <- nthArg 1 `mplus` pure Nothing+ mbformat <- case mbfmt of+ Nothing -> pure Nothing+ Just fmt ->+ case toTimeFormat <$> parseDisplayFormat fmt of+ Left e -> fail $ "Could not parse display format: " <> show e+ Right f -> pure $ Just f+ pure $ VString $ T.pack $+ case (mbdate, mbtime) of+ (Nothing, Just t) -> formatTime defaultTimeLocale (fromMaybe "%X" mbformat) t+ (Just d, Nothing) -> formatTime defaultTimeLocale (fromMaybe "%F" mbformat) d+ (Nothing, Nothing) -> ""+ (Just d, Just t) -> formatTime defaultTimeLocale (fromMaybe "%X %F" mbformat)+ (UTCTime d t)+ _ -> noMethod "DateTime" fld _ -> noMethod (drop 1 $ takeWhile (/= ' ') $ show val) fld pairToArray :: (Val, Val) -> Val@@ -664,3 +718,103 @@ | x == 4 = "IV" | x >= 1 = "I" <> toRomanNumeral (x - 1) | otherwise = ""++-- parser for DateTime display format++data FormatPart =+ Literal String+ | Variable String [(String, String)]+ deriving Show++parseDisplayFormat :: String -> Either ParseError [FormatPart]+parseDisplayFormat = parse (many pFormatPart <* eof) ""++pFormatPart :: Parser FormatPart+pFormatPart = pVariable <|> pLiteral++pLiteral :: Parser FormatPart+pLiteral = Literal <$> many1 (satisfy (/='['))++pVariable :: Parser FormatPart+pVariable = do+ void $ char '['+ name <- many1 letter+ spaces+ modifiers <- many pModifier+ void $ char ']'+ pure $ Variable name modifiers++pModifier :: Parser (String, String)+pModifier = do+ name <- many1 letter+ void $ char ':'+ spaces+ val <- many1 alphaNum+ spaces+ pure (name, val)++-- convert formatparts into Data.Time format string++toTimeFormat :: [FormatPart] -> String+toTimeFormat = concatMap toTimeFormatPart++toTimeFormatPart :: FormatPart -> String+toTimeFormatPart (Literal s) = foldr esc "" s+ where+ esc '%' = ("%%" ++)+ esc '\t' = ("%t" ++)+ esc '\n' = ("%n" ++)+ esc c = (c:)+toTimeFormatPart (Variable "year" mods) =+ withPadding mods $+ case lookup "repr" mods of+ Just "last_two" -> "y"+ _ -> "Y"+toTimeFormatPart (Variable "month" mods) =+ withPadding mods $+ case lookup "repr" mods of+ Just "numerical" -> "%m"+ Just "long" -> "b"+ Just "short" -> "h"+ _ -> "m"+toTimeFormatPart (Variable "day" mods) =+ case lookup "padding" mods of+ Just "space" -> "%e"+ Just "zero" -> "%d"+ _ -> "%e"+toTimeFormatPart (Variable "week_number" mods) =+ withPadding mods $+ case lookup "repr" mods of+ Just "ISO" -> "V"+ Just "sunday" -> "U"+ Just "monday" -> "W"+ _ -> "V"+toTimeFormatPart (Variable "weekday" mods) =+ withPadding mods $+ case lookup "repr" mods of+ Just "long" -> "A"+ Just "short" -> "a"+ Just "sunday" -> "w"+ Just "monday" -> "u"+ _ -> ""+toTimeFormatPart (Variable "hour" mods) =+ case lookup "hour" mods of+ Just "24" | lookup "padding" mods == Just "zero" -> "%H"+ | otherwise -> "%k"+ Just "12" | lookup "padding" mods == Just "zero" -> "%I"+ | otherwise -> "%l"+ _ -> "%k"+toTimeFormatPart (Variable "period" mods) =+ case lookup "case" mods of+ Just "lower" -> "%P"+ _ -> "%p"+toTimeFormatPart (Variable "minute" _) = "%M"+toTimeFormatPart (Variable "second" _) = "%S"+toTimeFormatPart _ = "?"++withPadding :: [(String, String)] -> String -> String+withPadding mods s = '%' :+ case lookup "padding" mods of+ Just "zero" -> '0' : s+ Just "space" -> '_' : s+ _ -> s
src/Typst/Module/Calc.hs view
@@ -114,12 +114,6 @@ [] -> fail "min requires one or more argument" _ : _ -> pure $ minimum vs ),- ( "mod",- makeFunction $ do- (a :: Integer) <- nthArg 1- (b :: Integer) <- nthArg 2- pure $ VInteger $ a `mod` b- ), ( "odd", makeFunction $ do v <- nthArg 1@@ -186,6 +180,8 @@ then fail "can't take square root of negative number" else pure $ VFloat $ sqrt n ),+ ("exp", makeFunction $ VFloat . exp <$> nthArg 1),+ ("ln", makeFunction $ VFloat . log <$> nthArg 1), ("cos", makeFunction $ VFloat . cos <$> nthArg 1), ("cosh", makeFunction $ VFloat . cosh <$> nthArg 1), ("sin", makeFunction $ VFloat . sin <$> nthArg 1),
src/Typst/Module/Math.hs view
@@ -45,6 +45,10 @@ [ ("index", One (TNone :|: TContent :|: TInteger :|: TRatio)), ("radicand", One TContent) ],+ makeElement (Just "math") "display" [("content", One TContent)],+ makeElement (Just "math") "inline" [("content", One TContent)],+ makeElement (Just "math") "script" [("content", One TContent)],+ makeElement (Just "math") "sscript" [("content", One TContent)], makeElement (Just "math") "sqrt" [("radicand", One TContent)], makeElement (Just "math") "cases" [("children", Many TContent)], makeElement (Just "math") "lr" [("body", Many TContent)],
src/Typst/Module/Standard.hs view
@@ -10,6 +10,7 @@ ) where +import Data.Char (ord, chr) import Control.Applicative ((<|>)) import Control.Monad (mplus, unless) import Control.Monad.Reader (lift)@@ -37,6 +38,10 @@ import Typst.Symbols (typstSymbols) import Typst.Types import Typst.Util+import Data.Time (UTCTime(..))+import Data.Time.Calendar (fromGregorianValid)+import Data.Time.Clock (secondsToDiffTime)+import Data.Digits (mDigits) standardModule :: M.Map Identifier Val standardModule =@@ -55,6 +60,7 @@ ++ meta ++ foundations ++ construct+ ++ time ++ dataLoading symModule :: M.Map Identifier Val@@ -375,9 +381,35 @@ ) ), ( "str",- makeFunction $ do+ makeFunctionWithScope+ (do val <- nthArg 1- VString <$> (fromVal val `mplus` pure (repr val))+ base <- namedArg "base" <|> pure (10 :: Integer)+ let digitVector :: V.Vector Char+ digitVector = V.fromList $ ['0'..'9'] ++ ['A'..'Z']+ let renderDigit n = digitVector V.!? (fromIntegral n)+ VString <$>+ case val of+ VInteger n | base /= 10+ -> case mDigits base n of+ Nothing -> fail "Could not convert number to base"+ Just ds -> maybe+ (fail "Could not convert number to base")+ (pure . T.pack)+ (mapM renderDigit ds)+ _ -> fromVal val `mplus` pure (repr val))+ [ ( "to-unicode",+ makeFunction $ do+ (val :: Text) <- nthArg 1+ case T.uncons val of+ Just (c, t) | T.null t ->+ pure $ VInteger $ fromIntegral $ ord c+ _ -> fail "to-unicode expects a single character" )+ , ( "from-unicode",+ makeFunction $ do+ (val :: Int) <- nthArg 1+ pure $ VString $ T.pack [chr val] )+ ] ), ( "symbol", makeFunction $ do@@ -443,6 +475,33 @@ loadFileText fp = do loadBytes <- evalLoadBytes <$> getState lift $ TE.decodeUtf8 <$> loadBytes fp++currentUTCTime :: Monad m => MP m UTCTime+currentUTCTime = (evalCurrentUTCTime <$> getState) >>= lift++time :: [(Identifier, Val)]+time =+ [ ( "datetime", makeFunctionWithScope+ (do+ mbyear <- namedArg "year" <|> pure Nothing+ mbmonth <- namedArg "month" <|> pure Nothing+ mbday <- namedArg "day" <|> pure Nothing+ let mbdate = case (mbyear, mbmonth, mbday) of+ (Just yr, Just mo, Just da) -> fromGregorianValid yr mo da+ _ -> Nothing+ mbhour <- namedArg "hour" <|> pure Nothing+ mbminute <- namedArg "minute" <|> pure Nothing+ mbsecond <- namedArg "second" <|> pure Nothing+ let mbtime = case (mbhour, mbminute, mbsecond) of+ (Just hr, Just mi, Just se) ->+ Just $ secondsToDiffTime $ (hr * 60 * 60) + (mi * 60) + se+ _ -> Nothing+ pure $ VDateTime mbdate mbtime)+ [ ("today", makeFunction $ do+ utcTime <- lift currentUTCTime+ pure $ VDateTime (Just (utctDay utcTime)) (Just (utctDayTime utcTime)) ) ]+ )+ ] dataLoading :: [(Identifier, Val)] dataLoading =
src/Typst/Types.hs view
@@ -57,7 +57,7 @@ import Data.Functor.Classes (Ord1 (liftCompare)) import qualified Data.Map as M import qualified Data.Map.Ordered as OM-import Data.Maybe (fromMaybe, isJust)+import Data.Maybe (fromMaybe, isJust, catMaybes) import Data.Scientific (floatingOrInteger) import Data.Sequence (Seq) import qualified Data.Sequence as Seq@@ -72,6 +72,8 @@ import Text.Read (readMaybe) import Typst.Regex (RE, makeLiteralRE) import Typst.Syntax (Identifier (..), Markup)+import Data.Time (UTCTime, Day, DiffTime)+import Data.Time.Format (defaultTimeLocale, formatTime) data Val = VNone@@ -88,6 +90,7 @@ | VSymbol !Symbol | VString !Text | VRegex !RE+ | VDateTime (Maybe Day) (Maybe DiffTime) | VContent (Seq Content) | VArray (Vector Val) | VDict (OM.OMap Identifier Val)@@ -129,6 +132,7 @@ | TSymbol | TString | TRegex+ | TDateTime | TContent | TArray | TDict@@ -163,6 +167,7 @@ VSymbol {} -> TSymbol VString {} -> TString VRegex {} -> TRegex+ VDateTime {} -> TDateTime VContent {} -> TContent VArray {} -> TArray VDict {} -> TDict@@ -523,7 +528,8 @@ evalShowRules :: [ShowRule], evalStyles :: M.Map Identifier Arguments, evalFlowDirective :: FlowDirective,- evalLoadBytes :: FilePath -> m BS.ByteString+ evalLoadBytes :: FilePath -> m BS.ByteString,+ evalCurrentUTCTime :: m UTCTime } emptyEvalState :: EvalState m@@ -534,7 +540,8 @@ evalShowRules = [], evalStyles = mempty, evalFlowDirective = FlowNormal,- evalLoadBytes = undefined+ evalLoadBytes = undefined,+ evalCurrentUTCTime = undefined } data Attempt a@@ -719,6 +726,8 @@ VContent cs -> prettyContent cs VString t -> "\"" <> escString t <> "\"" VRegex re -> P.text (show re)+ VDateTime d t -> P.text (unwords (catMaybes+ [show <$> d, formatTime defaultTimeLocale "%0H:%0M:%0S" <$> t])) VAuto -> "auto" VNone -> "none" VBoolean True -> "true"
test/Main.hs view
@@ -14,6 +14,7 @@ import Typst.Evaluate (evaluateTypst) import Typst.Parse (parseTypst) import Typst.Types (Val (VContent), repr)+import Data.Time (getCurrentTime) main :: IO () main = defaultMain =<< goldenTests@@ -51,7 +52,7 @@ case parseResult of Left e -> pure $ fromText $ T.pack $ show e Right parsed -> do- evalResult <- evaluateTypst BS.readFile input parsed+ evalResult <- evaluateTypst BS.readFile getCurrentTime input parsed let parseOutput = "--- parse tree ---\n" <> T.pack (ppShow parsed) <> "\n" case evalResult of Left e ->
typst.cabal view
@@ -1,10 +1,10 @@ cabal-version: 2.4 name: typst-version: 0.1.0.0+version: 0.2.0.0 synopsis: Parsing and evaluating typst syntax. description: A library for parsing and evaluating typst syntax. Typst (<https://typst.app>) is a document layout and- formatting language. This library targets typst 0.4+ formatting language. This library targets typst 0.5 and currently offers only partial support. license: BSD-3-Clause license-file: LICENSE@@ -55,7 +55,7 @@ -- other-extensions: build-depends: base >= 4.14 && <= 5,- typst-symbols >= 0.1 && < 0.2,+ typst-symbols >= 0.1.1 && < 0.2, mtl, vector, parsec,@@ -71,7 +71,9 @@ yaml, regex-tdfa, array,- pretty+ time,+ pretty,+ digits hs-source-dirs: src default-language: Haskell2010 @@ -95,6 +97,7 @@ containers, text, bytestring,+ time, pretty-show, ordered-containers else@@ -112,6 +115,7 @@ text, bytestring, filepath,+ time, pretty-show, tasty, tasty-golden