diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2016 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/iconv-typed.cabal b/iconv-typed.cabal new file mode 100644 --- /dev/null +++ b/iconv-typed.cabal @@ -0,0 +1,79 @@ +name: iconv-typed +version: 0.1.0.0 +synopsis: Type safe iconv wrapper +homepage: https://github.com/adinapoli/iconv-typed#readme +license: BSD3 +license-file: LICENSE +author: Alfredo Di Napoli +maintainer: alfredo.dinapoli@gmail.com +copyright: 2016 Alfredo Di Napoli +category: Web +build-type: Simple +cabal-version: >=1.10 + +description: + [iconv-typed] + . + An experiment in bringing type safety to the package. + . + [Usage Example] + This is _almost_ a drop-in replacement. Compare the original code from `iconv`: + . + > {-# LANGUAGE KindSignatures #-} + > {-# LANGUAGE DataKinds #-} + > {-# LANGUAGE OverloadedStrings #-} + > module Main where + > + > import Codec.Text.IConv + > + > main :: IO () + > main = print $ convert "UTF-8" "LATIN1" "hello" + . + With the equivalent in `iconv-typed`: + . + > {-# LANGUAGE KindSignatures #-} + > {-# LANGUAGE DataKinds #-} + > {-# LANGUAGE OverloadedStrings #-} + > module Main where + > + > import Codec.Text.IConv.Typed + > + > main :: IO () + > main = print $ convert (E :: E "UTF-8") (E :: E "LATIN1") "hello" + . + As a result, this code will compile and run only if the passed encoding resolves to a supported + encoding (as retrieved at compile time by calling `iconv -l`). For example, the following won't compile: + . + > main = print $ convert (E :: E "UFT-8") (E :: E "LATIN1") "hello" + . + As `UFT` is mispelled. + +library + hs-source-dirs: src + exposed-modules: Codec.Text.IConv.Typed + Codec.Text.IConv.Typed.TH + build-depends: base >= 4.7 && < 5, + iconv < 0.5, + shelly < 1.8.0.0, + text < 1.4.0.0, + template-haskell < 3.0.0.0, + bytestring + default-language: Haskell2010 + ghc-options: -Wall + if os(darwin) + other-modules: Codec.Text.IConv.Typed.MacOSX + else + other-modules: Codec.Text.IConv.Typed.Unix + +test-suite iconv-typed-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , iconv-typed + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/adinapoli/iconv-typed diff --git a/src/Codec/Text/IConv/Typed.hs b/src/Codec/Text/IConv/Typed.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Text/IConv/Typed.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE KindSignatures #-} +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} +module Codec.Text.IConv.Typed + ( E(..) + , ValidEncoding + , convert + , convertFuzzy + , convertStrictly + , convertLazily + -- * Handy re-exports + , I.reportConversionError + , I.Fuzzy(..) + , I.ConversionError(..) + , I.Span(..) + ) where + +import qualified Codec.Text.IConv as I +import Codec.Text.IConv.Typed.TH +import Data.ByteString.Lazy +import GHC.TypeLits + +$(generateEncodings) + +-------------------------------------------------------------------------------- +convert :: ( KnownSymbol k1 + , KnownSymbol k2 + , ValidEncoding k1 ~ 'True + , ValidEncoding k2 ~ 'True + ) + => E k1 -- ^ Name of input string encoding + -> E k2 -- ^ Name of output string encoding + -> ByteString -- ^ Input text + -> ByteString -- ^ Output text +convert e1 e2 input = I.convert (reifyEncoding e1) (reifyEncoding e2) input + +-------------------------------------------------------------------------------- +convertFuzzy :: ( KnownSymbol k1 + , KnownSymbol k2 + , ValidEncoding k1 ~ 'True + , ValidEncoding k2 ~ 'True + ) + => I.Fuzzy -- ^ Whether to try and transliterate or + -- discard characters with no direct conversion + -> E k1 -- ^ Name of input string encoding + -> E k2 -- ^ Name of output string encoding + -> ByteString -- ^ Input text + -> ByteString -- ^ Output text +convertFuzzy fuzzy fromEncoding toEncoding input = + I.convertFuzzy fuzzy (reifyEncoding fromEncoding) (reifyEncoding toEncoding) input + +-------------------------------------------------------------------------------- +convertStrictly :: ( KnownSymbol k1 + , KnownSymbol k2 + , ValidEncoding k1 ~ 'True + , ValidEncoding k2 ~ 'True + ) + => E k1 -- ^ Name of input string encoding + -> E k2 -- ^ Name of output string encoding + -> ByteString -- ^ Input text + -> Either ByteString I.ConversionError -- ^ Output text or conversion error +convertStrictly fromEncoding toEncoding input = + I.convertStrictly (reifyEncoding fromEncoding) (reifyEncoding toEncoding) input + +-------------------------------------------------------------------------------- +convertLazily :: ( KnownSymbol k1 + , KnownSymbol k2 + , ValidEncoding k1 ~ 'True + , ValidEncoding k2 ~ 'True + ) + => E k1 -- ^ Name of input string encoding + -> E k2 -- ^ Name of output string encoding + -> ByteString -- ^ Input text + -> [I.Span] -- ^ Output text spans +convertLazily fromEncoding toEncoding input = I.convertLazily (reifyEncoding fromEncoding) (reifyEncoding toEncoding) input diff --git a/src/Codec/Text/IConv/Typed/MacOSX.hs b/src/Codec/Text/IConv/Typed/MacOSX.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Text/IConv/Typed/MacOSX.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE OverloadedStrings #-} +module Codec.Text.IConv.Typed.MacOSX + ( getAvailableEncodings + ) where + +import Codec.Text.IConv (EncodingName) +import System.IO.Unsafe (unsafePerformIO) +import qualified Data.Text as T +import Shelly + +getAvailableEncodings :: [EncodingName] +getAvailableEncodings = unsafePerformIO $ shelly $ silently $ escaping False $ do + map T.unpack . mconcat . map T.words . T.lines . T.strip <$> run "iconv" ["-l"] +{-# NOINLINE getAvailableEncodings #-} diff --git a/src/Codec/Text/IConv/Typed/TH.hs b/src/Codec/Text/IConv/Typed/TH.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Text/IConv/Typed/TH.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE CPP #-} +module Codec.Text.IConv.Typed.TH where + +#if defined darwin_HOST_OS +import Codec.Text.IConv.Typed.MacOSX +#else +import Codec.Text.IConv.Typed.Unix +#endif + +import Codec.Text.IConv +import Data.List (foldl') +import Data.Maybe +import qualified Data.Text as T +import GHC.TypeLits +import Language.Haskell.TH +import Text.Read + +data E (k :: Symbol) = E + +reifyEncoding :: KnownSymbol k => E k -> String +reifyEncoding = symbolVal + +filterNumericEncoding :: [EncodingName] -> [EncodingName] +filterNumericEncoding = filter (not . numerical) + where + numerical x = isJust (readMaybe x :: Maybe Int) + +-------------------------------------------------------------------------------- +replacementRules :: [(T.Text, T.Text)] +replacementRules = [ ("-", "__") + , (".", "____") + , (":", "___") + ] + +-------------------------------------------------------------------------------- +applyRule :: T.Text -> (T.Text, T.Text) -> T.Text +applyRule t (input, output) = T.replace input output t + +-------------------------------------------------------------------------------- +convertName :: EncodingName -> EncodingName +convertName = T.unpack . (\t -> foldl' applyRule t replacementRules) . T.pack + +-- closedTypeFamilyD :: Name -> [TyVarBndr] -> FamilyResultSig -> Maybe InjectivityAnn -> [TySynEqnQ] -> DecQ + + +-------------------------------------------------------------------------------- +generateEncodings :: Q [Dec] +generateEncodings = do + let encs = getAvailableEncodings + let k = mkName "k" + let symbol = mkName "Symbol" + let validEncoding = mkName "ValidEncoding" + let bool = mkName "Bool" + let instances = flip map encs $ \eName -> do + return $ TySynEqn [LitT (StrTyLit eName)] (PromotedT (mkName "True")) + (: []) <$> closedTypeFamilyD validEncoding [KindedTV k (ConT symbol)] (KindSig (ConT bool)) Nothing instances diff --git a/src/Codec/Text/IConv/Typed/Unix.hs b/src/Codec/Text/IConv/Typed/Unix.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Text/IConv/Typed/Unix.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE OverloadedStrings #-} +module Codec.Text.IConv.Typed.Unix + ( getAvailableEncodings + ) where + +import Codec.Text.IConv (EncodingName) +import System.IO.Unsafe (unsafePerformIO) +import qualified Data.Text as T +import Shelly + +getAvailableEncodings :: [EncodingName] +getAvailableEncodings = unsafePerformIO $ shelly $ silently $ escaping False $ do + map T.unpack . T.splitOn "," . T.strip <$> run "iconv" ["-l"] +{-# NOINLINE getAvailableEncodings #-} diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"