Use Texts instead of Strings in all the codebase

Exceptions:
 - String is the only serialization data type supported by HDBC
 - FilePaths

dbmigrations.cabal

@@ -62,6 +62,7 @@ Source-Repository head
 
 Library
   default-language: Haskell2010
+  default-extensions: OverloadedStrings
   if impl(ghc >= 6.12.0)
     ghc-options: -Wall -fwarn-tabs -funbox-strict-fields
                  -fno-warn-unused-do-bind
@@ -81,6 +82,7 @@ Library
     template-haskell,
     yaml-light >= 0.1,
     bytestring >= 0.9,
+    string-conversions >= 0.4,
     text >= 0.11,
     configurator >= 0.2,
     split >= 0.2.2,
@@ -106,6 +108,7 @@ Library
 
 test-suite dbmigrations-tests
   default-language: Haskell2010
+  default-extensions: OverloadedStrings
   type: exitcode-stdio-1.0
   Build-Depends:
     base >= 4 && < 5,
@@ -119,6 +122,7 @@ test-suite dbmigrations-tests
     template-haskell,
     yaml-light >= 0.1,
     bytestring >= 0.9,
+    string-conversions >= 0.4,
     MissingH,
     HDBC >= 2.2.1,
     HUnit >= 1.2,

src/Database/Schema/Migrations.hs

@@ -9,6 +9,7 @@ module Database.Schema.Migrations
     )
 where
 
+import Data.Text ( Text )
 import qualified Data.Set as Set
 import Data.Maybe ( catMaybes )
 
@@ -25,7 +26,7 @@ import Database.Schema.Migrations.Migration
 -- |Given a 'B.Backend' and a 'S.MigrationMap', query the backend and
 -- return a list of migration names which are available in the
 -- 'S.MigrationMap' but which are not installed in the 'B.Backend'.
-missingMigrations :: B.Backend -> S.StoreData -> IO [String]
+missingMigrations :: B.Backend -> S.StoreData -> IO [Text]
 missingMigrations backend storeData = do
   let storeMigrationNames = map mId $ S.storeMigrations storeData
   backendMigrations <- B.getMigrations backend

src/Database/Schema/Migrations/Backend.hs

@@ -4,13 +4,15 @@ module Database.Schema.Migrations.Backend
     )
 where
 
+import Data.Text ( Text )
+
 import Database.Schema.Migrations.Migration
     ( Migration(..) )
 
 -- |Backend instances should use this as the name of the migration
 -- returned by getBootstrapMigration; this migration is special
 -- because it cannot be reverted.
-rootMigrationName :: String
+rootMigrationName :: Text
 rootMigrationName = "root"
 
 -- |A Backend represents a database engine backend such as MySQL or
@@ -55,7 +57,7 @@ data Backend =
             -- does not supply a revert instruction, this has no effect
             -- other than bookkeeping.
 
-            , getMigrations :: IO [String]
+            , getMigrations :: IO [Text]
             -- ^ Returns a list of installed migration names from the
             -- backend.
 
@@ -71,4 +73,4 @@ data Backend =
             }
 
 instance Show Backend where
-   show _ = show "dbmigrations backend"
+   show _ = "dbmigrations backend"

src/Database/Schema/Migrations/Backend/HDBC.hs

@@ -22,22 +22,25 @@ import Database.Schema.Migrations.Migration
     , newMigration
     )
 
+import Data.Text ( Text )
+import Data.String.Conversions ( cs, (<>) )
+
 import Control.Applicative ( (<$>) )
 import Data.Time.Clock (getCurrentTime)
 
-migrationTableName :: String
+migrationTableName :: Text
 migrationTableName = "installed_migrations"
 
-createSql :: String
-createSql = "CREATE TABLE " ++ migrationTableName ++ " (migration_id TEXT)"
+createSql :: Text
+createSql = "CREATE TABLE " <> migrationTableName <> " (migration_id TEXT)"
 
-revertSql :: String
-revertSql = "DROP TABLE " ++ migrationTableName
+revertSql :: Text
+revertSql = "DROP TABLE " <> migrationTableName
 
 -- |General Backend constructor for all HDBC connection implementations.
 hdbcBackend :: (IConnection conn) => conn -> Backend
 hdbcBackend conn =
-    Backend { isBootstrapped = elem migrationTableName <$> getTables conn
+    Backend { isBootstrapped = elem (cs migrationTableName) <$> getTables conn
             , getBootstrapMigration =
                   do
                     ts <- getCurrentTime
@@ -49,22 +52,22 @@ hdbcBackend conn =
                         }
 
             , applyMigration = \m -> do
-                runRaw conn (mApply m)
-                _ <- run conn ("INSERT INTO " ++ migrationTableName ++
+                runRaw conn (cs $ mApply m)
+                _ <- run conn (cs $ "INSERT INTO " <> migrationTableName <>
                           " (migration_id) VALUES (?)") [toSql $ mId m]
                 return ()
 
             , revertMigration = \m -> do
                   case mRevert m of
                     Nothing -> return ()
-                    Just query -> runRaw conn query
+                    Just query -> runRaw conn (cs query)
                   -- Remove migration from installed_migrations in either case.
-                  _ <- run conn ("DELETE FROM " ++ migrationTableName ++
+                  _ <- run conn (cs $ "DELETE FROM " <> migrationTableName <>
                             " WHERE migration_id = ?") [toSql $ mId m]
                   return ()
 
             , getMigrations = do
-                results <- quickQuery' conn ("SELECT migration_id FROM " ++ migrationTableName) []
+                results <- quickQuery' conn (cs $ "SELECT migration_id FROM " <> migrationTableName) []
                 return $ map (fromSql . head) results
 
             , commitBackend = commit conn

src/Database/Schema/Migrations/Dependencies.hs

@@ -11,7 +11,9 @@ module Database.Schema.Migrations.Dependencies
     )
 where
 
+import Data.Text ( Text )
 import Data.Maybe ( fromJust )
+import Data.Monoid ( (<>) )
 import Data.Graph.Inductive.Graph ( Graph(..), nodes, edges, Node, suc, pre, lab )
 import Data.Graph.Inductive.PatriciaTree ( Gr )
 
@@ -21,24 +23,24 @@ import Database.Schema.Migrations.CycleDetection ( hasCycle )
 -- and a list of other objects upon which they depend.
 class (Eq a, Ord a) => Dependable a where
     -- |The identifiers of the objects on which @a@ depends.
-    depsOf :: a -> [String]
+    depsOf :: a -> [Text]
     -- |The identifier of a 'Dependable' object.
-    depId :: a -> String
+    depId :: a -> Text
 
 -- |A 'DependencyGraph' represents a collection of objects together
 -- with a graph of their dependency relationships.  This is intended
 -- to be used with instances of 'Dependable'.
 data DependencyGraph a = DG { depGraphObjectMap :: [(a, Int)]
                             -- ^ A mapping of 'Dependable' objects to
                             -- their graph vertex indices.
-                            , depGraphNameMap :: [(String, Int)]
+                            , depGraphNameMap :: [(Text, Int)]
                             -- ^ A mapping of 'Dependable' object
                             -- identifiers to their graph vertex
                             -- indices.
-                            , depGraph :: Gr String String
+                            , depGraph :: Gr Text Text
                             -- ^ A directed 'Gr' (graph) of the
                             -- 'Dependable' objects' dependency
-                            -- relationships, with 'String' vertex and
+                            -- relationships, with 'Text' vertex and
                             -- edge labels.
                             }
 
@@ -65,14 +67,14 @@ mkDepGraph objects = if hasCycle theGraph
       n = [ (fromJust $ lookup o ids, depId o) | o <- objects ]
       e = [ ( fromJust $ lookup o ids
             , fromJust $ lookup d ids
-            , depId o ++ " -> " ++ depId d) | o <- objects, d <- depsOf' o ]
+            , depId o <> " -> " <> depId d) | o <- objects, d <- depsOf' o ]
       depsOf' o = map (\i -> fromJust $ lookup i objMap) $ depsOf o
 
       objMap = map (\o -> (depId o, o)) objects
       ids = zip objects [1..]
       names = map (\(o,i) -> (depId o, i)) ids
 
-type NextNodesFunc = Gr String String -> Node -> [Node]
+type NextNodesFunc = Gr Text Text -> Node -> [Node]
 
 cleanLDups :: (Eq a) => [a] -> [a]
 cleanLDups [] = []
@@ -82,16 +84,16 @@ cleanLDups (e:es) = if e `elem` es then (cleanLDups es) else (e:cleanLDups es)
 -- |Given a dependency graph and an ID, return the IDs of objects that
 -- the object depends on.  IDs are returned with least direct
 -- dependencies first (i.e., the apply order).
-dependencies :: (Dependable d) => DependencyGraph d -> String -> [String]
+dependencies :: (Dependable d) => DependencyGraph d -> Text -> [Text]
 dependencies g m = reverse $ cleanLDups $ dependenciesWith suc g m
 
 -- |Given a dependency graph and an ID, return the IDs of objects that
 -- depend on it.  IDs are returned with least direct reverse
 -- dependencies first (i.e., the revert order).
-reverseDependencies :: (Dependable d) => DependencyGraph d -> String -> [String]
+reverseDependencies :: (Dependable d) => DependencyGraph d -> Text -> [Text]
 reverseDependencies g m = reverse $ cleanLDups $ dependenciesWith pre g m
 
-dependenciesWith :: (Dependable d) => NextNodesFunc -> DependencyGraph d -> String -> [String]
+dependenciesWith :: (Dependable d) => NextNodesFunc -> DependencyGraph d -> Text -> [Text]
 dependenciesWith nextNodes dg@(DG _ nMap theGraph) name =
     let lookupId = fromJust $ lookup name nMap
         depNodes = nextNodes theGraph lookupId

src/Database/Schema/Migrations/Filesystem.hs

@@ -13,7 +13,11 @@ import Prelude
 
 import System.Directory ( getDirectoryContents, doesFileExist )
 import System.FilePath ( (</>), takeExtension, dropExtension, takeBaseName )
-import Data.ByteString.Char8 ( unpack )
+import Data.Text ( Text )
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.ByteString.Char8 as BSC
+import Data.String.Conversions ( cs, (<>) )
 
 import Data.Typeable ( Typeable )
 import Data.Time.Clock ( UTCTime )
@@ -33,7 +37,7 @@ import Database.Schema.Migrations.Migration
 import Database.Schema.Migrations.Filesystem.Serialize
 import Database.Schema.Migrations.Store
 
-type FieldProcessor = String -> Migration -> Maybe Migration
+type FieldProcessor = Text -> Migration -> Maybe Migration
 
 data FilesystemStoreSettings = FSStore { storePath :: FilePath }
 
@@ -62,39 +66,39 @@ filesystemStore s =
                        let migrationFilenames = [ f | f <- contents, isMigrationFilename f ]
                            fullPaths = [ (f, storePath s </> f) | f <- migrationFilenames ]
                        existing <- filterM (\(_, full) -> doesFileExist full) fullPaths
-                       return [ dropExtension short | (short, _) <- existing ]
+                       return [ cs $ dropExtension short | (short, _) <- existing ]
 
                    , saveMigration = \m -> do
                        filename <- fsFullMigrationName s $ mId m
-                       writeFile (addNewMigrationExtension filename) $ serializeMigration m
+                       BSC.writeFile (cs $ addNewMigrationExtension filename) $ serializeMigration m
                    }
 
 addNewMigrationExtension :: FilePath -> FilePath
-addNewMigrationExtension path = path ++ filenameExtension
+addNewMigrationExtension path = path <> filenameExtension
 
 addMigrationExtension :: FilePath -> String -> FilePath
-addMigrationExtension path ext = path ++ ext
+addMigrationExtension path ext = path <> ext
 
 -- |Build path to migrations without extension.
-fsFullMigrationName :: FilesystemStoreSettings -> FilePath -> IO FilePath
-fsFullMigrationName s name = return $ storePath s </> name
+fsFullMigrationName :: FilesystemStoreSettings -> Text -> IO FilePath
+fsFullMigrationName s name = return $ storePath s </> cs name
 
-isMigrationFilename :: FilePath -> Bool
-isMigrationFilename path = takeExtension path `elem` [filenameExtension, filenameExtensionTxt]
+isMigrationFilename :: String -> Bool
+isMigrationFilename path = (cs $ takeExtension path) `elem` [filenameExtension, filenameExtensionTxt]
 
 -- |Given a store and migration name, read and parse the associated
 -- migration and return the migration if successful.  Otherwise return
 -- a parsing error message.
-migrationFromFile :: FilesystemStoreSettings -> String -> IO (Either String Migration)
+migrationFromFile :: FilesystemStoreSettings -> Text -> IO (Either String Migration)
 migrationFromFile store name =
-    fsFullMigrationName store name >>= migrationFromPath
+    fsFullMigrationName store (cs name) >>= migrationFromPath
 
 -- |Given a filesystem path, read and parse the file as a migration
 -- return the 'Migration' if successful.  Otherwise return a parsing
 -- error message.
 migrationFromPath :: FilePath -> IO (Either String Migration)
 migrationFromPath path = do
-  let name = takeBaseName path
+  let name = cs $ takeBaseName path
   (Right <$> process name) `catch` (\(FilesystemStoreError s) -> return $ Left $ "Could not parse migration " ++ path ++ ":" ++ s)
 
   where
@@ -119,34 +123,34 @@ migrationFromPath path = do
             Just m -> return m
         _ -> throwFS $ "Error in " ++ (show path) ++ ": missing required field(s): " ++ (show missing)
 
-getFields :: YamlLight -> [(String, String)]
+getFields :: YamlLight -> [(Text, Text)]
 getFields (YMap mp) = map toPair $ Map.assocs mp
     where
-      toPair (YStr k, YStr v) = (unpack k, unpack v)
+      toPair (YStr k, YStr v) = (T.decodeUtf8 k, T.decodeUtf8 v)
       toPair (k, v) = throwFS $ "Error in YAML input; expected string key and string value, got " ++ (show (k, v))
 getFields _ = throwFS "Error in YAML input; expected mapping"
 
-missingFields :: [(String, String)] -> [String]
+missingFields :: [(Text, Text)] -> [Text]
 missingFields fs =
     [ k | k <- requiredFields, not (k `elem` inputStrings) ]
     where
       inputStrings = map fst fs
 
 -- |Given a migration and a list of parsed migration fields, update
 -- the migration from the field values for recognized fields.
-migrationFromFields :: Migration -> [(String, String)] -> Maybe Migration
+migrationFromFields :: Migration -> [(Text, Text)] -> Maybe Migration
 migrationFromFields m [] = Just m
 migrationFromFields m ((name, value):rest) = do
   processor <- lookup name fieldProcessors
   newM <- processor value m
   migrationFromFields newM rest
 
-requiredFields :: [String]
+requiredFields :: [Text]
 requiredFields = [ "Apply"
                  , "Depends"
                  ]
 
-fieldProcessors :: [(String, FieldProcessor)]
+fieldProcessors :: [(Text, FieldProcessor)]
 fieldProcessors = [ ("Created", setTimestamp )
                   , ("Description", setDescription )
                   , ("Apply", setApply )
@@ -161,8 +165,8 @@ setTimestamp value m = do
           _ -> fail "expected one valid parse"
   return $ m { mTimestamp = Just ts }
 
-readTimestamp :: String -> [(UTCTime, String)]
-readTimestamp = reads
+readTimestamp :: Text -> [(UTCTime, String)]
+readTimestamp = reads . cs
 
 setDescription :: FieldProcessor
 setDescription desc m = Just $ m { mDesc = Just desc }
@@ -174,4 +178,4 @@ setRevert :: FieldProcessor
 setRevert revert m = Just $ m { mRevert = Just revert }
 
 setDepends :: FieldProcessor
-setDepends depString m = Just $ m { mDeps = words depString }
+setDepends depString m = Just $ m { mDeps = T.words depString }