module Language.CalDims.Texts where import qualified Data.Version as Version -- Types data HelpTree = Section String [HelpTree] | Para String -- Classes -- Instances instance Show HelpTree where show = unlines . show' 0 where show' :: Int -> HelpTree -> [String] show' level ht = case ht of (Section s list) -> headline s ++ (concatMap (show' (level + 1)) list) (Para s) -> [indent s] where indent :: String -> String indent = ((concat $ take level $ repeat " ") ++) headline :: String -> [String] headline s = indent "" : if level >= length typoChars then [indent s ++":"] else [indent s, indent (take (length s) (repeat (typoChars!!level)))] typoChars = "*-'" -- Functions version :: Version.Version version = Version.Version [0,1,0] [] name :: String name = "CalDims" preludeText, welcomeText :: String preludeText = unlines [ "# Time Units" , "\\u s" , "min := 60 s" , "h := 60 min" , "d := 24 h" , "Hz := 1s^-1" , "" , "# Space Units" , "\\u m" , "l := (0.1 m)^3" , "" , "# Mass Units" , "\\u kg" , "t := 1000 kg" , "u := 1.6605402 * 10^-27 kg" , "" , "# Molar mass" , "\\u mol" , "" , "# Force" , "N := 1m kg/s^2" , "" , "# Energy" , "J := 1 N m" , "" , "# Power" , "W := 1 J/s" , "" , "# Electro physics" , "\\u A" , "C := 1 A s" , "V := 1 W/A" , "F := 1 A s/V" , "Ohm := 1 V/A" , "H := 1 V s/A" , "" , "# Light" , "\\u cd" , "" , "# Temperature" , "\\u K" , "" , "# Constants"] welcomeText = name ++ " " ++ Version.showVersion version ++ "\n" ++ "License: GPL 3 (see the LICENSE file)\n\n" ++ "Type in `\\?' to read the inline help.\n" helpText :: HelpTree helpText = Section (name ++ " help") [ Section "Usage of the shell" [ Para "The shell is an infinite loop that accepts one line of user-input and processes it." , Para "The input line syntax is: expr|command|fundef|unitdef|comment" , Section "Expression to evaluate (expr)" [ Para "The syntax of an evaluation request is: expr ('|'(unit|expr|-|*|?))." , Para "For detailed expression syntax see chapter `Expression syntax'." , Section "Examples" [ Para "(10000 m^2)^1%2 -> 100 m (square root of 10000 m^2)" , Para "7 d | h -> 168 h (7 days are 168 hours)" , Para "80W * 30d * 0.20EUR/kW/h | EUR -> 11.52 EUR" , Para "sin (pi/4) * 10 V -> 7.071067811865475 V"] , Section "Evaluation modifiers" [ Para "expr | unit -> converts expr to unit after evaluation" , Para "expr1 | expr2 -> rewrite expr in terms of expr2" , Para "expr | ? -> try to find the minimal unit for expr" , Para "expr | * -> simply keep the unit that was evaluated" , Para "expr | - -> rewrite the evaluation in terms of basic units" , Para [] , Para "Modifiers are optional, 'expr | *' and 'expr' are equivalent."] ] , Section "Shell command (command)" [ Para "\\? - display this help" , Para "\\d expr - show unevaluated expression" , Para "\\de expr - just like `\\d expr'" , Para "\\dn name - show unit or function" , Para "\\dp name - show the dependencies and the reverse dependecies of a unit or function" , Para "\\p string - print to stdout." , Para "\\r name - remove a function or unit." , Para "\\rc name - remove cascade - remove all entities that depend on and itself." , Para "\\s - print the state" , Para "\\u name - add a basic unit"] , Section "Function definition (fundef)" [ Para "A function definition has the following syntax: name (name1:unit1, name2:unit2, ...) = expr" , Section "Examples" [ Para "t = 3 min" , Para "volumen (radius:m) = pi * radius^3" , Para "speed (distance:m, time:s) = distance / time"] , Para "" , Para "Units that have to follow a parameter and colon indicate the dimension of the parameter only," , Para "so 'duration(t1:min, t2:min)=t2-t1' and 'duration(t1:h, t2:d)=t2-t1' are totally equivalent."] , Section "Unit definition (unitdef)" [ Para "A unit definition has the following syntax: name:=expr" , Section "Examples" [ Para "mile := 1609.344 m" , Para "min := 60 s" , Para "h := 60 min" , Para "mph := 1 mile/h"] ] , Section "Comment line (comment)" [ Para "You can add comment lines to your source files or comment out a line inside the shell." , Para "A comment line has the following syntax: # string" , Section "Example" [Para "# This is a comment"] ] ] , Section "Command invocation" [ Para "caldims [OPTION] " , Para "caldims - start the shell and load the user's `prelude.cal'" , Para "caldims - start the shell and load instead of `prelude.cal'" , Para "caldims --blank - start the shell without loading a file" , Para "caldims --echo - echo every input line" , Para "caldims --help - display this help text"] , Section "Expression syntax (expr)" [ Para "Currently only arithmetic expressions are supported." , Section "Examples" [ Para "1+2 -> 3" , Para "1m + 2m -> 3 m" , Para "1m * 2m -> 2 m^2"] , Section "Builtin functions. All of these are dimensionless." [ Para "pi -> pi" , Para "e -> Euler number" , Para "logBase (a, b) -> logarithm of a with base b" , Para "log (a) -> logarithm of a with base e" , Para "exp (a) -> expotential function (e^a)" , Para "" , Para "sin, cos, tan, asin, acos, atan, sinh, cosh, tanh, asinh, acosh, atanh"] , Section "Syntax productions" [ Section "An expression (expr) may be of one of the following forms" [ Para "- expr" , Para "expr + expr" , Para "expr - expr" , Para "expr * expr" , Para "expr / expr" , Para "expr ^ integer>" , Para "(expr)" , Para "number unit" , Para "functionname" , Para "functionname (arg1, arg2, ... )"] , Section "A number can be" [ Para "real" , Para "integer%integer"] , Section "A unit is one of" [ Para "unit / unit" , Para "unit unit" , Para "(unit)" , Para "unitname" , Para "unitname ^ integer"]]] , Section "The `prelude.cal' file" [ Para ("When a user starts " ++ name ++ " and `prelude.cal' cannot be found in the") , Para "`data directory, then a standard prelude is created. It contains definitions of" , Para "the SI base units and some derived units. You can replace or modify this file."]]