1{-| 2Module : Data.Ini.Config 3Copyright : (c) Getty Ritter, 2017 4License : BSD 5Maintainer : Getty Ritter <config-ini@infinitenegativeutility.com> 6Stability : experimental 7 8The 'config-ini' library exports some simple monadic functions to 9make parsing INI-like configuration easier. INI files have a 10two-level structure: the top-level named chunks of configuration, 11and the individual key-value pairs contained within those chunks. 12For example, the following INI file has two sections, @NETWORK@ 13and @LOCAL@, and each contains its own key-value pairs. Comments, 14which begin with @#@ or @;@, are ignored: 15 16> [NETWORK] 17> host = example.com 18> port = 7878 19> 20> # here is a comment 21> [LOCAL] 22> user = terry 23 24The combinators provided here are designed to write quick and 25idiomatic parsers for files of this form. Sections are parsed by 26'IniParser' computations, like 'section' and its variations, 27while the fields within sections are parsed by 'SectionParser' 28computations, like 'field' and its variations. If we want to 29parse an INI file like the one above, treating the entire 30@LOCAL@ section as optional, we can write it like this: 31 32> data Config = Config 33> { cfNetwork :: NetworkConfig, cfLocal :: Maybe LocalConfig } 34> deriving (Eq, Show) 35> 36> data NetworkConfig = NetworkConfig 37> { netHost :: String, netPort :: Int } 38> deriving (Eq, Show) 39> 40> data LocalConfig = LocalConfig 41> { localUser :: Text } 42> deriving (Eq, Show) 43> 44> configParser :: IniParser Config 45> configParser = do 46> netCf <- section "NETWORK" $ do 47> host <- fieldOf "host" string 48> port <- fieldOf "port" number 49> return NetworkConfig { netHost = host, netPort = port } 50> locCf <- sectionMb "LOCAL" $ 51> LocalConfig <$> field "user" 52> return Config { cfNetwork = netCf, cfLocal = locCf } 53 54 55We can run our computation with 'parseIniFile', which, 56when run on our example file above, would produce the 57following: 58 59>>> parseIniFile example configParser 60Right (Config {cfNetwork = NetworkConfig {netHost = "example.com", netPort = 7878}, cfLocal = Just (LocalConfig {localUser = "terry"})}) 61 62-} 63 64{-# LANGUAGE OverloadedStrings #-} 65{-# LANGUAGE ScopedTypeVariables #-} 66{-# LANGUAGE GeneralizedNewtypeDeriving #-} 67 68module Data.Ini.Config 69( 70-- * Parsing Files 71 parseIniFile 72-- * Parser Types 73, IniParser 74, SectionParser 75-- * Section-Level Parsing 76, section 77, sections 78, sectionOf 79, sectionsOf 80, sectionMb 81, sectionDef 82-- * Field-Level Parsing 83, field 84, fieldOf 85, fieldMb 86, fieldMbOf 87, fieldDef 88, fieldDefOf 89, fieldFlag 90, fieldFlagDef 91-- * Reader Functions 92, readable 93, number 94, string 95, flag 96, listWithSeparator 97) where 98 99import Control.Applicative (Alternative(..)) 100import Control.Monad.Trans.Except 101import Data.Ini.Config.Raw 102import Data.Sequence (Seq) 103import qualified Data.Sequence as Seq 104import Data.String (IsString(..)) 105import Data.Text (Text) 106import qualified Data.Text as T 107import Data.Typeable (Typeable, Proxy(..), typeRep) 108import GHC.Exts (IsList(..)) 109import Text.Read (readMaybe) 110 111lkp :: NormalizedText -> Seq (NormalizedText, a) -> Maybe a 112lkp t = go . Seq.viewl 113 where go ((t', x) Seq.:< rs) 114 | t == t' = Just x 115 | otherwise = go (Seq.viewl rs) 116 go Seq.EmptyL = Nothing 117 118addLineInformation :: Int -> Text -> StParser s a -> StParser s a 119addLineInformation lineNo sec = withExceptT go 120 where go e = "Line " ++ show lineNo ++ 121 ", in section " ++ show sec ++ 122 ": " ++ e 123 124type StParser s a = ExceptT String ((->) s) a 125 126-- | An 'IniParser' value represents a computation for parsing entire 127-- INI-format files. 128newtype IniParser a = IniParser (StParser RawIni a) 129 deriving (Functor, Applicative, Alternative, Monad) 130 131-- | A 'SectionParser' value represents a computation for parsing a single 132-- section of an INI-format file. 133newtype SectionParser a = SectionParser (StParser IniSection a) 134 deriving (Functor, Applicative, Alternative, Monad) 135 136-- | Parse a 'Text' value as an INI file and run an 'IniParser' over it 137parseIniFile :: Text -> IniParser a -> Either String a 138parseIniFile text (IniParser mote) = do 139 ini <- parseRawIni text 140 runExceptT mote ini 141 142-- | Find a named section in the INI file and parse it with the provided 143-- section parser, failing if the section does not exist. In order to 144-- support classic INI files with capitalized section names, section 145-- lookup is __case-insensitive__. 146-- 147-- >>> parseIniFile "[ONE]\nx = hello\n" $ section "ONE" (field "x") 148-- Right "hello" 149-- >>> parseIniFile "[ONE]\nx = hello\n" $ section "TWO" (field "x") 150-- Left "No top-level section named \"TWO\"" 151section :: Text -> SectionParser a -> IniParser a 152section name (SectionParser thunk) = IniParser $ ExceptT $ \(RawIni ini) -> 153 case lkp (normalize name) ini of 154 Nothing -> Left ("No top-level section named " ++ show name) 155 Just sec -> runExceptT thunk sec 156 157-- | Find multiple named sections in the INI file and parse them all 158-- with the provided section parser. In order to support classic INI 159-- files with capitalized section names, section lookup is 160-- __case-insensitive__. 161-- 162-- >>> parseIniFile "[ONE]\nx = hello\n[ONE]\nx = goodbye\n" $ sections "ONE" (field "x") 163-- Right (fromList ["hello","goodbye"]) 164-- >>> parseIniFile "[ONE]\nx = hello\n" $ sections "TWO" (field "x") 165-- Right (fromList []) 166sections :: Text -> SectionParser a -> IniParser (Seq a) 167sections name (SectionParser thunk) = IniParser $ ExceptT $ \(RawIni ini) -> 168 let name' = normalize name 169 in mapM (runExceptT thunk . snd) 170 (Seq.filter (\ (t, _) -> t == name') ini) 171 172-- | A call to @sectionOf f@ will apply @f@ to each section name and, 173-- if @f@ produces a "Just" value, pass the extracted value in order 174-- to get the "SectionParser" to use for that section. This will 175-- find at most one section, and will produce an error if no section 176-- exists. 177-- 178-- >>> parseIniFile "[FOO]\nx = hello\n" $ sectionOf (T.stripSuffix "OO") (\ l -> fmap ((,) l) (field "x")) 179-- Right ("F","hello") 180-- >>> parseIniFile "[BAR]\nx = hello\n" $ sectionOf (T.stripSuffix "OO") (\ l -> fmap ((,) l) (field "x")) 181-- Left "No matching top-level section" 182sectionOf :: (Text -> Maybe b) -> (b -> SectionParser a) -> IniParser a 183sectionOf fn sectionParser = IniParser $ ExceptT $ \(RawIni ini) -> 184 let go Seq.EmptyL = Left "No matching top-level section" 185 go ((t, sec) Seq.:< rs) 186 | Just v <- fn (actualText t) = 187 let SectionParser thunk = sectionParser v 188 in runExceptT thunk sec 189 | otherwise = go (Seq.viewl rs) 190 in go (Seq.viewl ini) 191 192 193-- | A call to @sectionsOf f@ will apply @f@ to each section name and, 194-- if @f@ produces a @Just@ value, pass the extracted value in order 195-- to get the "SectionParser" to use for that section. This will 196-- return every section for which the call to @f@ produces a "Just" 197-- value. 198-- 199-- >>> parseIniFile "[FOO]\nx = hello\n[BOO]\nx = goodbye\n" $ sectionsOf (T.stripSuffix "OO") (\ l -> fmap ((,) l) (field "x")) 200-- Right (fromList [("F","hello"),("B","goodbye")]) 201-- >>> parseIniFile "[BAR]\nx = hello\n" $ sectionsOf (T.stripSuffix "OO") (\ l -> fmap ((,) l) (field "x")) 202-- Right (fromList []) 203sectionsOf :: (Text -> Maybe b) -> (b -> SectionParser a) -> IniParser (Seq a) 204sectionsOf fn sectionParser = IniParser $ ExceptT $ \(RawIni ini) -> 205 let go Seq.EmptyL = return Seq.empty 206 go ((t, sec) Seq.:< rs) 207 | Just v <- fn (actualText t) = 208 let SectionParser thunk = sectionParser v 209 in do 210 x <- runExceptT thunk sec 211 xs <- go (Seq.viewl rs) 212 return (x Seq.<| xs) 213 | otherwise = go (Seq.viewl rs) 214 in go (Seq.viewl ini) 215 216-- | Find a named section in the INI file and parse it with the provided 217-- section parser, returning 'Nothing' if the section does not exist. 218-- In order to 219-- support classic INI files with capitalized section names, section 220-- lookup is __case-insensitive__. 221-- 222-- >>> parseIniFile "[ONE]\nx = hello\n" $ sectionMb "ONE" (field "x") 223-- Right (Just "hello") 224-- >>> parseIniFile "[ONE]\nx = hello\n" $ sectionMb "TWO" (field "x") 225-- Right Nothing 226sectionMb :: Text -> SectionParser a -> IniParser (Maybe a) 227sectionMb name (SectionParser thunk) = IniParser $ ExceptT $ \(RawIni ini) -> 228 case lkp (normalize name) ini of 229 Nothing -> return Nothing 230 Just sec -> Just `fmap` runExceptT thunk sec 231 232-- | Find a named section in the INI file and parse it with the provided 233-- section parser, returning a default value if the section does not exist. 234-- In order to 235-- support classic INI files with capitalized section names, section 236-- lookup is __case-insensitive__. 237-- 238-- >>> parseIniFile "[ONE]\nx = hello\n" $ sectionDef "ONE" "def" (field "x") 239-- Right "hello" 240-- >>> parseIniFile "[ONE]\nx = hello\n" $ sectionDef "TWO" "def" (field "x") 241-- Right "def" 242sectionDef :: Text -> a -> SectionParser a -> IniParser a 243sectionDef name def (SectionParser thunk) = IniParser $ ExceptT $ \(RawIni ini) -> 244 case lkp (normalize name) ini of 245 Nothing -> return def 246 Just sec -> runExceptT thunk sec 247 248--- 249 250throw :: String -> StParser s a 251throw msg = ExceptT $ (\ _ -> Left msg) 252 253getSectionName :: StParser IniSection Text 254getSectionName = ExceptT $ (\ m -> return (isName m)) 255 256rawFieldMb :: Text -> StParser IniSection (Maybe IniValue) 257rawFieldMb name = ExceptT $ \m -> 258 return (lkp (normalize name) (isVals m)) 259 260rawField :: Text -> StParser IniSection IniValue 261rawField name = do 262 sec <- getSectionName 263 valMb <- rawFieldMb name 264 case valMb of 265 Nothing -> throw ("Missing field " ++ show name ++ 266 " in section " ++ show sec) 267 Just x -> return x 268 269getVal :: IniValue -> Text 270getVal = T.strip . vValue 271 272-- | Retrieve a field, failing if it doesn't exist, and return its raw value. 273-- 274-- >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (field "x") 275-- Right "hello" 276-- >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (field "y") 277-- Left "Missing field \"y\" in section \"MAIN\"" 278field :: Text -> SectionParser Text 279field name = SectionParser $ getVal `fmap` rawField name 280 281-- | Retrieve a field and use the supplied parser to parse it as a value, 282-- failing if the field does not exist, or if the parser fails to 283-- produce a value. 284-- 285-- >>> parseIniFile "[MAIN]\nx = 72\n" $ section "MAIN" (fieldOf "x" number) 286-- Right 72 287-- >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldOf "x" number) 288-- Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a value of type Integer" 289-- >>> parseIniFile "[MAIN]\nx = 72\n" $ section "MAIN" (fieldOf "y" number) 290-- Left "Missing field \"y\" in section \"MAIN\"" 291fieldOf :: Text -> (Text -> Either String a) -> SectionParser a 292fieldOf name parse = SectionParser $ do 293 sec <- getSectionName 294 val <- rawField name 295 case parse (getVal val) of 296 Left err -> addLineInformation (vLineNo val) sec (throw err) 297 Right x -> return x 298 299-- | Retrieve a field, returning a @Nothing@ value if it does not exist. 300-- 301-- >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldMb "x") 302-- Right (Just "hello") 303-- >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldMb "y") 304-- Right Nothing 305fieldMb :: Text -> SectionParser (Maybe Text) 306fieldMb name = SectionParser $ fmap getVal `fmap` rawFieldMb name 307 308-- | Retrieve a field and parse it according to the given parser, returning 309-- @Nothing@ if it does not exist. If the parser fails, then this will 310-- fail. 311-- 312-- >>> parseIniFile "[MAIN]\nx = 72\n" $ section "MAIN" (fieldMbOf "x" number) 313-- Right (Just 72) 314-- >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldMbOf "x" number) 315-- Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a value of type Integer" 316-- >>> parseIniFile "[MAIN]\nx = 72\n" $ section "MAIN" (fieldMbOf "y" number) 317-- Right Nothing 318fieldMbOf :: Text -> (Text -> Either String a) -> SectionParser (Maybe a) 319fieldMbOf name parse = SectionParser $ do 320 sec <- getSectionName 321 mb <- rawFieldMb name 322 case mb of 323 Nothing -> return Nothing 324 Just v -> case parse (getVal v) of 325 Left err -> addLineInformation (vLineNo v) sec (throw err) 326 Right x -> return (Just x) 327 328-- | Retrieve a field and supply a default value for if it doesn't exist. 329-- 330-- >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldDef "x" "def") 331-- Right "hello" 332-- >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldDef "y" "def") 333-- Right "def" 334fieldDef :: Text -> Text -> SectionParser Text 335fieldDef name def = SectionParser $ ExceptT $ \m -> 336 case lkp (normalize name) (isVals m) of 337 Nothing -> return def 338 Just x -> return (getVal x) 339 340-- | Retrieve a field, parsing it according to the given parser, and returning 341-- a default value if it does not exist. If the parser fails, then this will 342-- fail. 343-- 344-- >>> parseIniFile "[MAIN]\nx = 72\n" $ section "MAIN" (fieldDefOf "x" number 99) 345-- Right 72 346-- >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldDefOf "x" number 99) 347-- Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a value of type Integer" 348-- >>> parseIniFile "[MAIN]\nx = 72\n" $ section "MAIN" (fieldDefOf "y" number 99) 349-- Right 99 350fieldDefOf :: Text -> (Text -> Either String a) -> a -> SectionParser a 351fieldDefOf name parse def = SectionParser $ do 352 sec <- getSectionName 353 mb <- rawFieldMb name 354 case mb of 355 Nothing -> return def 356 Just v -> case parse (getVal v) of 357 Left err -> addLineInformation (vLineNo v) sec (throw err) 358 Right x -> return x 359 360-- | Retrieve a field and treat it as a boolean, failing if it 361-- does not exist. 362-- 363-- >>> parseIniFile "[MAIN]\nx = yes\n" $ section "MAIN" (fieldFlag "x") 364-- Right True 365-- >>> parseIniFile "[MAIN]\nx = yes\n" $ section "MAIN" (fieldFlag "y") 366-- Left "Missing field \"y\" in section \"MAIN\"" 367fieldFlag :: Text -> SectionParser Bool 368fieldFlag name = fieldOf name flag 369 370-- | Retrieve a field and treat it as a boolean, subsituting 371-- a default value if it doesn't exist. 372-- 373-- >>> parseIniFile "[MAIN]\nx = yes\n" $ section "MAIN" (fieldFlagDef "x" False) 374-- Right True 375-- >>> parseIniFile "[MAIN]\nx = hello\n" $ section "MAIN" (fieldFlagDef "x" False) 376-- Left "Line 2, in section \"MAIN\": Unable to parse \"hello\" as a boolean" 377-- >>> parseIniFile "[MAIN]\nx = yes\n" $ section "MAIN" (fieldFlagDef "y" False) 378-- Right False 379fieldFlagDef :: Text -> Bool -> SectionParser Bool 380fieldFlagDef name def = fieldDefOf name flag def 381 382--- 383 384-- | Try to use the "Read" instance for a type to parse a value, failing 385-- with a human-readable error message if reading fails. 386-- 387-- >>> readable "(5, 7)" :: Either String (Int, Int) 388-- Right (5,7) 389-- >>> readable "hello" :: Either String (Int, Int) 390-- Left "Unable to parse \"hello\" as a value of type (Int,Int)" 391readable :: forall a. (Read a, Typeable a) => Text -> Either String a 392readable t = case readMaybe str of 393 Just v -> Right v 394 Nothing -> Left ("Unable to parse " ++ show str ++ 395 " as a value of type " ++ show typ) 396 where str = T.unpack t 397 typ = typeRep prx 398 prx :: Proxy a 399 prx = Proxy 400 401-- | Try to use the "Read" instance for a numeric type to parse a value, 402-- failing with a human-readable error message if reading fails. 403-- 404-- >>> number "5" :: Either String Int 405-- Right 5 406-- >>> number "hello" :: Either String Int 407-- Left "Unable to parse \"hello\" as a value of type Int" 408number :: (Num a, Read a, Typeable a) => Text -> Either String a 409number = readable 410 411-- | Convert a textual value to the appropriate string type. This will 412-- never fail. 413-- 414-- >>> string "foo" :: Either String String 415-- Right "foo" 416string :: (IsString a) => Text -> Either String a 417string = return . fromString . T.unpack 418 419-- | Convert a string that represents a boolean to a proper boolean. This 420-- is case-insensitive, and matches the words @true@, @false@, @yes@, 421-- @no@, as well as single-letter abbreviations for all of the above. 422-- If the input does not match, then this will fail with a human-readable 423-- error message. 424-- 425-- >>> flag "TRUE" 426-- Right True 427-- >>> flag "y" 428-- Right True 429-- >>> flag "no" 430-- Right False 431-- >>> flag "F" 432-- Right False 433-- >>> flag "That's a secret!" 434-- Left "Unable to parse \"That's a secret!\" as a boolean" 435flag :: Text -> Either String Bool 436flag s = case T.toLower s of 437 "true" -> Right True 438 "yes" -> Right True 439 "t" -> Right True 440 "y" -> Right True 441 "false" -> Right False 442 "no" -> Right False 443 "f" -> Right False 444 "n" -> Right False 445 _ -> Left ("Unable to parse " ++ show s ++ " as a boolean") 446 447-- | Convert a reader for a value into a reader for a list of those 448-- values, separated by a chosen separator. This will split apart 449-- the string on that separator, get rid of leading and trailing 450-- whitespace on the individual chunks, and then attempt to parse 451-- each of them according to the function provided, turning the 452-- result into a list. 453-- 454-- This is overloaded with the "IsList" typeclass, so it can be 455-- used transparently to parse other list-like types. 456-- 457-- >>> listWithSeparator "," number "2, 3, 4" :: Either String [Int] 458-- Right [2,3,4] 459-- >>> listWithSeparator " " number "7 8 9" :: Either String [Int] 460-- Right [7,8,9] 461-- >>> listWithSeparator ":" string "/bin:/usr/bin" :: Either String [FilePath] 462-- Right ["/bin","/usr/bin"] 463-- >>> listWithSeparator "," number "7 8 9" :: Either String [Int] 464-- Left "Unable to parse \"7 8 9\" as a value of type Int" 465listWithSeparator :: (IsList l) 466 => Text 467 -> (Text -> Either String (Item l)) 468 -> Text -> Either String l 469listWithSeparator sep rd = 470 fmap fromList . mapM (rd . T.strip) . T.splitOn sep 471 472-- $setup 473-- 474-- >>> :{ 475-- data NetworkConfig = NetworkConfig 476-- { netHost :: String, netPort :: Int } 477-- deriving (Eq, Show) 478-- >>> :} 479-- 480-- >>> :{ 481-- data LocalConfig = LocalConfig 482-- { localUser :: Text } 483-- deriving (Eq, Show) 484-- >>> :} 485-- 486-- >>> :{ 487-- data Config = Config 488-- { cfNetwork :: NetworkConfig, cfLocal :: Maybe LocalConfig } 489-- deriving (Eq, Show) 490-- >>> :} 491-- 492-- >>> :{ 493-- let configParser = do 494-- netCf <- section "NETWORK" $ do 495-- host <- fieldOf "host" string 496-- port <- fieldOf "port" number 497-- return NetworkConfig { netHost = host, netPort = port } 498-- locCf <- sectionMb "LOCAL" $ 499-- LocalConfig <$> field "user" 500-- return Config { cfNetwork = netCf, cfLocal = locCf } 501-- >>> :} 502-- 503-- >>> :{ 504-- let example = "[NETWORK]\nhost = example.com\nport = 7878\n\n# here is a comment\n[LOCAL]\nuser = terry\n" 505-- >>> :} 506