hsilop 0.1.2.0 → 0.2.0.0
raw patch · 2 files changed
+55/−29 lines, 2 filesdep +directorydep +filepathdep +xdg-basedir
Dependencies added: directory, filepath, xdg-basedir
Files
- hsilop.cabal +4/−3
- src/Main.hs +51/−26
hsilop.cabal view
@@ -1,5 +1,5 @@ name: hsilop-version: 0.1.2.0+version: 0.2.0.0 synopsis: RPN calculator description: @@ -25,6 +25,7 @@ main-is: Main.hs hs-source-dirs: src default-language: Haskell2010- other-extensions: ViewPatterns- build-depends: base ==4.*, haskeline+ other-extensions: ViewPatterns, LambdaCase+ build-depends: base ==4.*, haskeline,+ directory, filepath, xdg-basedir ghc-options: -O2
src/Main.hs view
@@ -1,50 +1,73 @@-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE ViewPatterns, LambdaCase #-} -import Data.List-import Data.Maybe-import Text.Read-import Text.Printf-import Control.Monad+import Control.Monad (foldM)+import Data.List (isPrefixOf)+import Text.Read (readMaybe)+import Text.Printf (printf)+import System.Directory (createDirectoryIfMissing)+import System.FilePath (takeDirectory)+import System.Environment.XDG.BaseDir (getUserDataFile) import System.Console.Haskeline+import System.Console.Haskeline.Completion ++-- | Run calculator main :: IO ()-main = runInputT defaultSettings repl+main = settings >>= flip runInputT repl ++-- | Program main loop repl :: InputT IO ()-repl = do- line <- getInputLine "ꟼ "- case fromMaybe "" line of- "q" -> return ()- "" -> outputStrLn "" >> repl- exp -> outputStrLn (result (rpn exp) ++ "\n") >> repl+repl = getInputLine "ꟼ " >>= \case+ Nothing -> return ()+ Just "" -> repl+ Just exp -> outputStrLn (result (rpn exp) ++ "\n") >> repl --- Pretty print RPN result/errors+-- | Program settings+-- add function name completion and history+settings :: IO (Settings IO)+settings = do+ path <- getUserDataFile "hsilop" "history"+ createDirectoryIfMissing True (takeDirectory path)+ return $ Settings (completeWord Nothing "\t " complete) (Just path) True+ where+ names = map fst monad ++ map fst nilad+ complete x = return $ map simpleCompletion (filter (isPrefixOf x) names)+++-- | Pretty print RPN result/errors result :: Either String Double -> String result (Left err) = "Ꞥ∘ " ++ err-result (Right x) = printf format x where+result (Right x) = printf format x where format | ceiling x == floor x = "∘ %.0f" | otherwise = "∘ %.10f" --- Solve a RPN expression+-- | Solve a RPN expression rpn :: String -> Either String Double-rpn = foldM parse [] . words >=> return . head where - parse (y:x:xs) (flip lookup dyad -> Just f) = Right (f x y : xs)- parse (x:xs) (flip lookup monad -> Just f) = Right (f x : xs)- parse xs (flip lookup nilad -> Just k) = Right (k : xs)- parse xs (readMaybe -> Just x) = Right (x : xs)- parse _ _ = Left "syntax error"+rpn = fmap head . foldM parse [] . words where+ parse (y:x:xs) (flip lookup dyad -> Just f) = Right (f x y : xs)+ parse (x:xs) (flip lookup monad -> Just f) = Right (f x : xs)+ parse xs (flip lookup nilad -> Just k) = Right (k : xs)+ parse xs (readMaybe -> Just x) = Right (x : xs)+ parse _ _ = Left "syntax error" --- dyadic functions+-- Functions --++-- | Dyadic+-- i.e. operators+dyad :: [(String, Double -> Double -> Double)] dyad = [ ("+", (+)) , ("-", (-)) , ("*", (*)) , ("/", (/)) , ("^", (**)) ] --- monadic functions+-- | Monadic+-- i.e. single argument functions+monad :: [(String, Double -> Double)] monad = [ ("sin" , sin ) , ("asin" , asin) , ("cos" , cos )@@ -53,12 +76,14 @@ , ("atan" , atan) , ("ln" , log ) , ("sqrt" , sqrt)+ , ("abs" , abs ) , ("sgn" , signum)- , ("abs" , abs) , ("floor", fromIntegral . floor) , ("ceil" , fromIntegral . ceiling) ] --- niladic functions+-- | Niladic+-- i.e. constants+nilad :: [(String, Double)] nilad = [ ("pi" , pi) , ("e" , exp 1) , ("phi", (1 + sqrt 5)/2) ]