{-# OPTIONS_GHC -Wall #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  ToySolver.Internal.Util
-- Copyright   :  (c) Masahiro Sakai 2011-2012
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  portable
--
-- Some utility functions.
--
-----------------------------------------------------------------------------

module ToySolver.Internal.Util where

import Control.Monad
import Data.Ratio
import Data.Set (Set)
import qualified Data.Set as Set
import System.IO
import GHC.IO.Encoding

-- | Combining two @Maybe@ values using given function.
combineMaybe :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
combineMaybe :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
combineMaybe a -> a -> a
_ Maybe a
Nothing Maybe a
y = Maybe a
y
combineMaybe a -> a -> a
_ Maybe a
x Maybe a
Nothing = Maybe a
x
combineMaybe a -> a -> a
f (Just a
x) (Just a
y) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> a -> a
f a
x a
y)

-- | is the number integral?
--
-- @
--    isInteger x = fromInteger (round x) == x
-- @
isInteger :: RealFrac a => a -> Bool
isInteger :: a -> Bool
isInteger a
x = Integer -> a
forall a. Num a => Integer -> a
fromInteger (a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round a
x) a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x

-- | fractional part
--
-- @
--   fracPart x = x - fromInteger (floor x)
-- @
fracPart :: RealFrac a => a -> a
fracPart :: a -> a
fracPart a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
- Integer -> a
forall a. Num a => Integer -> a
fromInteger (a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor a
x)

showRational :: Bool -> Rational -> String
showRational :: Bool -> Rational -> String
showRational Bool
asRatio Rational
v
  | Rational -> Integer
forall a. Ratio a -> a
denominator Rational
v Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 = Integer -> String
forall a. Show a => a -> String
show (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
v)
  | Bool
asRatio            = Integer -> String
forall a. Show a => a -> String
show (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
v) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
v)
  | Bool
otherwise          = Double -> String
forall a. Show a => a -> String
show (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
v :: Double)

showRationalAsFiniteDecimal :: Rational -> Maybe String
showRationalAsFiniteDecimal :: Rational -> Maybe String
showRationalAsFiniteDecimal Rational
x = do
  let a :: Integer
      (Integer
a,Rational
b) = Rational -> (Integer, Rational)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Rational -> Rational
forall a. Num a => a -> a
abs Rational
x)
      s1 :: String
s1 = if Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0 then String
"-" else String
""
      s2 :: String
s2 = Integer -> String
forall a. Show a => a -> String
show Integer
a
  String
s3 <- if Rational
b Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0
        then String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return String
".0"
        else (String -> String) -> Maybe String -> Maybe String
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ ) (Maybe String -> Maybe String) -> Maybe String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Set Rational -> Rational -> Maybe String
loop Set Rational
forall a. Set a
Set.empty Rational
b
  String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
s1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s3
  where
    loop :: Set Rational -> Rational -> Maybe String
    loop :: Set Rational -> Rational -> Maybe String
loop Set Rational
_ Rational
0 = String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
    loop Set Rational
rs Rational
r
      | Rational
r Rational -> Set Rational -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Rational
rs = Maybe String
forall (m :: * -> *) a. MonadPlus m => m a
mzero
      | Bool
otherwise = do
          let a :: Integer
              (Integer
a,Rational
b) = Rational -> (Integer, Rational)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Rational
r Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
10)
          String
s <- Set Rational -> Rational -> Maybe String
loop (Rational -> Set Rational -> Set Rational
forall a. Ord a => a -> Set a -> Set a
Set.insert Rational
r Set Rational
rs) Rational
b
          String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s

{-# INLINE revSequence #-}
revSequence :: Monad m => [m a] -> m [a]
revSequence :: [m a] -> m [a]
revSequence = [a] -> [m a] -> m [a]
forall (m :: * -> *) a. Monad m => [a] -> [m a] -> m [a]
go []
  where
    go :: [a] -> [m a] -> m [a]
go [a]
xs [] = [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
xs
    go [a]
xs (m a
m:[m a]
ms) = do
      a
x <- m a
m
      [a] -> [m a] -> m [a]
go (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [m a]
ms

{-# INLINE revMapM #-}
revMapM :: Monad m => (a -> m b) -> ([a] -> m [b])
revMapM :: (a -> m b) -> [a] -> m [b]
revMapM a -> m b
f = [m b] -> m [b]
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
revSequence ([m b] -> m [b]) -> ([a] -> [m b]) -> [a] -> m [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m b) -> [a] -> [m b]
forall a b. (a -> b) -> [a] -> [b]
map a -> m b
f

{-# INLINE revForM #-}
revForM :: Monad m => [a] -> (a -> m b) -> m [b]
revForM :: [a] -> (a -> m b) -> m [b]
revForM = ((a -> m b) -> [a] -> m [b]) -> [a] -> (a -> m b) -> m [b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m b) -> [a] -> m [b]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
revMapM

setEncodingChar8 :: IO ()
setEncodingChar8 :: IO ()
setEncodingChar8 = do
  TextEncoding -> IO ()
setLocaleEncoding TextEncoding
char8
  TextEncoding -> IO ()
setForeignEncoding TextEncoding
char8
  TextEncoding -> IO ()
setFileSystemEncoding TextEncoding
char8