diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,6 @@ +# 0.2.0.0 + +* Switch to attoparsec to reduce dependency footprint +* Fix build with GHC 7.8 + +# 0.1.0.0 initial release diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,6 @@ +# system-locale + + +[![Hackage](https://img.shields.io/hackage/v/system-locale.svg)](https://hackage.haskell.org/package/system-locale) + +Read system locales from Haskell. diff --git a/src/System/Locale/Read.hs b/src/System/Locale/Read.hs --- a/src/System/Locale/Read.hs +++ b/src/System/Locale/Read.hs @@ -1,46 +1,51 @@ +{-# LANGUAGE DeriveDataTypeable #-} {-| Read locales on unix systems and parse them into their corresponding 'TimeLocale' representation. -} module System.Locale.Read - (getLocale - ,getCurrentLocale - ,parseLocale - ,TimeLocale(..) - ,LocaleParseException(..) + ( getLocale + , getCurrentLocale + , parseLocale + , TimeLocale(..) + , LocaleParseException(..) ) where -import Control.Exception -import Data.Time.Format (TimeLocale(..)) -import System.Process -import Text.Megaparsec -import Text.Megaparsec.String +import Control.Applicative +import Control.Exception +import Data.Attoparsec.Text +import qualified Data.Text as Text +import Data.Time.Format (TimeLocale(..)) +import Data.Typeable +import System.Process -- | Thrown when the locale cannot be parsed data LocaleParseException = - LocaleParseException (ParseError Char Dec) - deriving (Show,Eq) + LocaleParseException String + deriving (Show,Eq,Typeable) instance Exception LocaleParseException -- | 'Parser' for locales returned by the unix utility 'locale' parseLocale :: Parser TimeLocale -parseLocale = - do abDay <- parseSemicolonSeparatedLine - day <- parseSemicolonSeparatedLine - abMon <- parseSemicolonSeparatedLine - mon <- parseSemicolonSeparatedLine - [am,pm] <- parseSemicolonSeparatedLine - dateTimeFmt' <- manyTill anyChar newline - dateFmt' <- manyTill anyChar newline - timeFmt' <- manyTill anyChar newline - time12Fmt' <- manyTill anyChar newline - pure (TimeLocale (zip day abDay) - (zip mon abMon) - (am,pm) - dateTimeFmt' - dateFmt' - timeFmt' - time12Fmt' - []) +parseLocale = do + abDay <- parseSemicolonSeparatedLine + day <- parseSemicolonSeparatedLine + abMon <- parseSemicolonSeparatedLine + mon <- parseSemicolonSeparatedLine + [am, pm] <- parseSemicolonSeparatedLine + dateTimeFmt' <- manyTill anyChar newline + dateFmt' <- manyTill anyChar newline + timeFmt' <- manyTill anyChar newline + time12Fmt' <- manyTill anyChar newline + pure + (TimeLocale + (zip day abDay) + (zip mon abMon) + (am, pm) + dateTimeFmt' + dateFmt' + timeFmt' + time12Fmt' + []) -- | Read a locale with 'LC_TIME' set according to the first argument. -- @@ -51,13 +56,11 @@ -- -- > getLocale (Just "en_US.UTF-8") getLocale :: Maybe String -> IO TimeLocale -getLocale localeName = - do output <- - readCreateProcess (getLocaleProcess localeName) - "" - case runParser parseLocale "" output of - Left err -> throwIO (LocaleParseException err) - Right locale -> pure locale +getLocale localeName = do + output <- readCreateProcess (getLocaleProcess localeName) "" + case parseOnly (parseLocale <* endOfInput) (Text.pack output) of + Left err -> throwIO (LocaleParseException err) + Right locale -> pure locale -- | Get the current locale of the process. -- @@ -81,11 +84,14 @@ ,"t_fmt" ,"t_fmt_ampm"]) {env = toLangEnv <$> localeName} +newline :: Parser Char +newline = char '\n' + parseSemicolonSeparatedLine :: Parser [String] parseSemicolonSeparatedLine = - sepBy (many (noneOf [';','\n'])) - (char ';') <* - newline + sepBy (many (satisfy (not . finalChar))) (char ';') <* newline + where + finalChar c = c == ';' || c == '\n' toLangEnv :: String -> [(String,String)] toLangEnv s = [("LC_TIME",s)] diff --git a/system-locale.cabal b/system-locale.cabal --- a/system-locale.cabal +++ b/system-locale.cabal @@ -1,25 +1,28 @@ name: system-locale -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Get system locales -description: Please see README.md +description: Get system locales in a format suitable for the time library homepage: https://github.com/cocreature/system-locale license: BSD3 license-file: LICENSE author: Moritz Kiefer maintainer: moritz.kiefer@purelyfunctional.org -copyright: 2016 +copyright: 2016-2017 category: Unknown build-type: Simple --- extra-source-files: +extra-source-files: CHANGELOG.md + README.md cabal-version: >=1.10 +tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.1 library hs-source-dirs: src exposed-modules: System.Locale.Read - build-depends: base >= 4.7 && < 5 - , megaparsec >= 5.0 && < 5.2 - , process >= 1.2 && < 1.5 - , time >= 1.5 && < 1.7 + build-depends: attoparsec >= 0.13 && < 0.14 + , base >= 4.7 && < 5 + , process >= 1.2 && < 1.7 + , time >= 1.5 && < 1.9 + , text >= 1.2 && < 1.3 ghc-options: -Wall default-language: Haskell2010 @@ -27,6 +30,7 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs + other-modules: System.Locale.ReadSpec build-depends: base , hspec , system-locale diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,1 +1,7 @@ -{-# OPTIONS_GHC -F -pgmF hspec-discover #-} +import qualified System.Locale.ReadSpec as ReadSpec +import Test.Hspec + +main :: IO () +main = + hspec $ do + ReadSpec.spec diff --git a/test/System/Locale/ReadSpec.hs b/test/System/Locale/ReadSpec.hs new file mode 100644 --- /dev/null +++ b/test/System/Locale/ReadSpec.hs @@ -0,0 +1,66 @@ +module System.Locale.ReadSpec + ( spec + ) where + +import System.Locale.Read +import Test.Hspec + +spec :: Spec +spec = + do describe "getLocale" $ + do it "should return the en_US.UTF-8 locale" $ + getLocale (Just "en_US.UTF-8") `shouldReturn` + TimeLocale + [("Sunday","Sun") + ,("Monday","Mon") + ,("Tuesday","Tue") + ,("Wednesday","Wed") + ,("Thursday","Thu") + ,("Friday","Fri") + ,("Saturday","Sat")] + [("January","Jan") + ,("February","Feb") + ,("March","Mar") + ,("April","Apr") + ,("May","May") + ,("June","Jun") + ,("July","Jul") + ,("August","Aug") + ,("September","Sep") + ,("October","Oct") + ,("November","Nov") + ,("December","Dec")] + ("AM","PM") + "%a %d %b %Y %r %Z" + "%m/%d/%Y" + "%r" + "%I:%M:%S %p" + [] + it "should return the de_DE.UTF-8 locale" $ + getLocale (Just "de_DE.UTF-8") `shouldReturn` + TimeLocale + [("Sonntag","So") + ,("Montag","Mo") + ,("Dienstag","Di") + ,("Mittwoch","Mi") + ,("Donnerstag","Do") + ,("Freitag","Fr") + ,("Samstag","Sa")] + [("Januar","Jan") + ,("Februar","Feb") + ,("M\228rz","M\228r") + ,("April","Apr") + ,("Mai","Mai") + ,("Juni","Jun") + ,("Juli","Jul") + ,("August","Aug") + ,("September","Sep") + ,("Oktober","Okt") + ,("November","Nov") + ,("Dezember","Dez")] + ("","") + "%a %d %b %Y %T %Z" + "%d.%m.%Y" + "%T" + "" + []