diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,77 @@ +CSIRO Open Source Software License Agreement (variation of the BSD / MIT +License) + +Copyright (c) 2016, Commonwealth Scientific and Industrial Research Organisation +(CSIRO) ABN 41 687 119 230. + +All rights reserved. CSIRO is willing to grant you a license to this +aemo-webservice on the following terms, except where otherwise indicated for +third party material. + +Redistribution and use of this software 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 CSIRO nor the names of its contributors may be used to + endorse or promote products derived from this software without specific prior + written permission of CSIRO. + +EXCEPT AS EXPRESSLY STATED IN THIS AGREEMENT AND TO THE FULL EXTENT PERMITTED BY +APPLICABLE LAW, THE SOFTWARE IS PROVIDED "AS-IS". CSIRO MAKES NO +REPRESENTATIONS, WARRANTIES OR CONDITIONS OF ANY KIND, EXPRESS OR IMPLIED, +INCLUDING BUT NOT LIMITED TO ANY REPRESENTATIONS, WARRANTIES OR CONDITIONS +REGARDING THE CONTENTS OR ACCURACY OF THE SOFTWARE, OR OF TITLE, +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, NON-INFRINGEMENT, THE ABSENCE +OF LATENT OR OTHER DEFECTS, OR THE PRESENCE OR ABSENCE OF ERRORS, WHETHER OR NOT +DISCOVERABLE. + +TO THE FULL EXTENT PERMITTED BY APPLICABLE LAW, IN NO EVENT SHALL CSIRO BE +LIABLE ON ANY LEGAL THEORY (INCLUDING, WITHOUT LIMITATION, IN AN ACTION FOR +BREACH OF CONTRACT, NEGLIGENCE OR OTHERWISE) FOR ANY CLAIM, LOSS, DAMAGES OR +OTHER LIABILITY HOWSOEVER INCURRED. WITHOUT LIMITING THE SCOPE OF THE PREVIOUS +SENTENCE THE EXCLUSION OF LIABILITY SHALL INCLUDE: LOSS OF PRODUCTION OR +OPERATION TIME, LOSS, DAMAGE OR CORRUPTION OF DATA OR RECORDS; OR LOSS OF +ANTICIPATED SAVINGS, OPPORTUNITY, REVENUE, PROFIT OR GOODWILL, OR OTHER ECONOMIC +LOSS; OR ANY SPECIAL, INCIDENTAL, INDIRECT, CONSEQUENTIAL, PUNITIVE OR EXEMPLARY +DAMAGES, ARISING OUT OF OR IN CONNECTION WITH THIS AGREEMENT, ACCESS OF THE +SOFTWARE OR ANY OTHER DEALINGS WITH THE SOFTWARE, EVEN IF CSIRO HAS BEEN ADVISED +OF THE POSSIBILITY OF SUCH CLAIM, LOSS, DAMAGES OR OTHER LIABILITY. + +APPLICABLE LEGISLATION SUCH AS THE AUSTRALIAN CONSUMER LAW MAY APPLY +REPRESENTATIONS, WARRANTIES, OR CONDITIONS, OR IMPOSES OBLIGATIONS OR LIABILITY +ON CSIRO THAT CANNOT BE EXCLUDED, RESTRICTED OR MODIFIED TO THE FULL EXTENT SET +OUT IN THE EXPRESS TERMS OF THIS CLAUSE ABOVE "CONSUMER GUARANTEES". TO THE +EXTENT THAT SUCH CONSUMER GUARANTEES CONTINUE TO APPLY, THEN TO THE FULL EXTENT +PERMITTED BY THE APPLICABLE LEGISLATION, THE LIABILITY OF CSIRO UNDER THE +RELEVANT CONSUMER GUARANTEE IS LIMITED (WHERE PERMITTED AT CSIRO'S OPTION) TO +ONE OF FOLLOWING REMEDIES OR SUBSTANTIALLY EQUIVALENT REMEDIES: + +(a) THE REPLACEMENT OF THE SOFTWARE, THE SUPPLY OF EQUIVALENT + SOFTWARE, OR SUPPLYING RELEVANT SERVICES AGAIN; +(b) THE REPAIR OF THE SOFTWARE; +(c) THE PAYMENT OF THE COST OF REPLACING THE + SOFTWARE, OF ACQUIRING EQUIVALENT SOFTWARE, HAVING THE + RELEVANT SERVICES SUPPLIED AGAIN, OR HAVING THE SOFTWARE + REPAIRED. + +IN THIS CLAUSE, CSIRO INCLUDES ANY THIRD PARTY AUTHOR OR OWNER OF ANY PART OF +THE SOFTWARE OR MATERIAL DISTRIBUTED WITH IT. CSIRO MAY ENFORCE ANY RIGHTS ON +BEHALF OF THE RELEVANT THIRD PARTY. + +Third Party Components + +The following third party components are distributed with the Software. You +agree to comply with the license terms for these components as part of accessing +the Software. Other third party software may also be identified in separate +files distributed with the Software. + +___________________________________________________________________ + +___________________________________________________________________ diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,44 @@ +#!/usr/bin/env runhaskell +\begin{code} +{-# OPTIONS_GHC -Wall #-} +module Main (main) where + +import Data.List ( nub ) +import Data.Version ( showVersion ) +import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName ) +import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) ) +import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) +import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose ) +import Distribution.Simple.BuildPaths ( autogenModulesDir ) +import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag ) +import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) ) +import Distribution.Verbosity ( Verbosity ) +import System.FilePath ( () ) + +main :: IO () +main = defaultMainWithHooks simpleUserHooks + { buildHook = \pkg lbi hooks flags -> do + generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi + buildHook simpleUserHooks pkg lbi hooks flags + } + +generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () +generateBuildModule verbosity pkg lbi = do + let dir = autogenModulesDir lbi + createDirectoryIfMissingVerbose verbosity True dir + withLibLBI pkg lbi $ \_ libcfg -> do + withTestLBI pkg lbi $ \suite suitecfg -> do + rewriteFile (dir "Build_" ++ testName suite ++ ".hs") $ unlines + [ "module Build_" ++ testName suite ++ " where" + , "deps :: [String]" + , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg)) + ] + where + formatdeps = map (formatone . snd) + formatone p = case packageName p of + PackageName n -> n ++ "-" ++ showVersion (packageVersion p) + +testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] +testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys + +\end{code} diff --git a/alphachar.cabal b/alphachar.cabal new file mode 100644 --- /dev/null +++ b/alphachar.cabal @@ -0,0 +1,69 @@ +name: alphachar +version: 0.0.1 +license: BSD3 +license-file: LICENSE +author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> +maintainer: Tony Morris +copyright: Copyright (c) 2016, Commonwealth Scientific and Industrial Research Organisation (CSIRO) ABN 41 687 119 230. +synopsis: A character between a-z +category: Prelude +description: A character between a-z +homepage: https://github.com/data61/alphachar +bug-reports: https://github.com/data61/alphachar/issues +cabal-version: >= 1.10 +build-type: Custom +extra-source-files: changelog + +source-repository head + type: git + location: git@github.com:data61/alphachar.git + +flag small_base + description: Choose the new, split-up base package. + +library + default-language: + Haskell2010 + + build-depends: + base >= 4.8 && < 5 + , lens >= 4.1 && < 5 + , parsers >= 0.12 && < 1 + + ghc-options: + -Wall + + default-extensions: + NoImplicitPrelude + + hs-source-dirs: + src + + exposed-modules: + Data.Char.Alpha + +test-suite doctests + type: + exitcode-stdio-1.0 + + main-is: + doctests.hs + + default-language: + Haskell2010 + + build-depends: + base < 5 && >= 3 + , doctest >= 0.9.7 + , filepath >= 1.3 + , directory >= 1.1 + , QuickCheck >= 2.0 + , template-haskell >= 2.8 + , parsec >= 0.12 && < 1 + + ghc-options: + -Wall + -threaded + + hs-source-dirs: + test diff --git a/changelog b/changelog new file mode 100644 --- /dev/null +++ b/changelog @@ -0,0 +1,4 @@ +0.0.1 + +* Initial release + diff --git a/src/Data/Char/Alpha.hs b/src/Data/Char/Alpha.hs new file mode 100644 --- /dev/null +++ b/src/Data/Char/Alpha.hs @@ -0,0 +1,214 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE RankNTypes #-} + +module Data.Char.Alpha( +-- * Upper-case + AlphaUpper +, HasAlphaUpper(alphaUpper) +, AsAlphaUpper(_AlphaUpper) +, parseAlphaUpper +-- * Lower-case +, AlphaLower +, HasAlphaLower(alphaLower) +, AsAlphaLower(_AlphaLower) +, parseAlphaLower +-- * Any case +, Alpha(UpperAlpha, LowerAlpha) +, HasAlpha(alpha) +, AsAlpha(_Alpha, _UpperAlpha, _LowerAlpha) +, parseAlpha +-- * Accessory +, upperlower +, lowerupper +) where + +import Control.Applicative((<$>), (<|>), empty) +import Control.Category((.), id) +import Control.Lens(makeClassy, makeClassyPrisms, from, iso, prism', (^?), Iso', Prism') +import Control.Monad(Monad((>>=), return)) +import Data.Char(Char, toLower, toUpper) +import Data.Eq(Eq) +import Data.Foldable(elem) +import Data.Maybe(Maybe(Just, Nothing), maybe) +import Data.Ord(Ord) +import Prelude(Show) +import Text.Parser.Char(CharParsing, anyChar) +import Text.Parser.Combinators((), try) + +-- $setup +-- +-- >>> import Text.Parsec(parse) + +-- | An upper-case character between @'A'@ and @'Z'@. +newtype AlphaUpper = + AlphaUpper Char + deriving (Eq, Ord, Show) + +makeClassy ''AlphaUpper + +class AsAlphaUpper a where + _AlphaUpper :: + Prism' + a + AlphaUpper + +instance AsAlphaUpper AlphaUpper where + _AlphaUpper = + id + +instance AsAlphaUpper Char where + _AlphaUpper = + prism' + (\(AlphaUpper c) -> c) + (\c -> if c `elem` ['A'..'Z'] + then + Just (AlphaUpper c) + else + Nothing) + +-- | Parse an upper-case alpha character. +-- +-- >>> parse parseAlphaUpper "parseAlphaUpper" "A" +-- Right (AlphaUpper 'A') +-- +-- >>> parse parseAlphaUpper "parseAlphaUpper" "Abc" +-- Right (AlphaUpper 'A') +-- +-- >>> isn't _Right (parse parseAlphaUpper "parseAlphaUpper" "a") +-- True +-- +-- >>> isn't _Right (parse parseAlphaUpper "parseAlphaUpper" "") +-- True +-- +-- >>> isn't _Right (parse parseAlphaUpper "parseAlphaUpper" "0") +-- True +parseAlphaUpper :: + (Monad f, CharParsing f) => + f AlphaUpper +parseAlphaUpper = + try (anyChar >>= \c -> maybe empty return (c ^? _AlphaUpper)) "AlphaUpper" + +-- | A lower-case character between @'a'@ and @'z'@. +newtype AlphaLower = + AlphaLower Char + deriving (Eq, Ord, Show) + +makeClassy ''AlphaLower + +class AsAlphaLower a where + _AlphaLower :: + Prism' + a + AlphaLower + +instance AsAlphaLower AlphaLower where + _AlphaLower = + id + +instance AsAlphaLower Char where + _AlphaLower = + prism' + (\(AlphaLower c) -> c) + (\c -> if c `elem` ['a'..'z'] + then + Just (AlphaLower c) + else + Nothing) + +-- | Parse a lower-case alpha character. +-- +-- >>> parse parseAlphaLower "parseAlphaLower" "a" +-- Right (AlphaLower 'a') +-- +-- >>> parse parseAlphaLower "parseAlphaLower" "aBC" +-- Right (AlphaLower 'a') +-- +-- >>> isn't _Right (parse parseAlphaLower "parseAlphaLower" "B") +-- True +-- +-- >>> isn't _Right (parse parseAlphaLower "parseAlphaLower" "") +-- True +-- +-- >>> isn't _Right (parse parseAlphaLower "parseAlphaLower" "0") +-- True +parseAlphaLower :: + (Monad f, CharParsing f) => + f AlphaLower +parseAlphaLower = + try (anyChar >>= \c -> maybe empty return (c ^? _AlphaLower)) "AlphaLower" + +-- | Either a lower-case character between @'a'@ and @'z'@ or an upper-case character between @'A'@ and @'Z'@. +data Alpha = + UpperAlpha AlphaUpper + | LowerAlpha AlphaLower + deriving (Eq, Ord, Show) + +makeClassyPrisms ''Alpha +makeClassy ''Alpha + +-- | Parse an upper-case or lower-case character. +-- +-- >>> parse parseAlpha "parseAlpha" "a" +-- Right (LowerAlpha (AlphaLower 'a')) +-- +-- >>> parse parseAlpha "parseAlpha" "aBC" +-- Right (LowerAlpha (AlphaLower 'a')) +-- +-- >>> parse parseAlpha "parseAlpha" "A" +-- Right (UpperAlpha (AlphaUpper 'A')) +-- +-- >>> parse parseAlpha "parseAlpha" "Abc" +-- Right (UpperAlpha (AlphaUpper 'A')) +-- +-- >>> isn't _Right (parse parseAlpha "parseAlpha" "0") +-- True +parseAlpha :: + (Monad f, CharParsing f) => + f Alpha +parseAlpha = + UpperAlpha <$> parseAlphaUpper <|> LowerAlpha <$> parseAlphaLower + +instance AsAlphaLower Alpha where + _AlphaLower = + _LowerAlpha . _AlphaLower + +instance AsAlphaUpper Alpha where + _AlphaUpper = + _UpperAlpha . _AlphaUpper + +-- | Isomorphism from upper to lower. +-- +-- >>> (upperlower #) <$> ('a' ^? _AlphaLower) +-- Just (AlphaUpper 'A') +-- +-- >>> (upperlower #) <$> ('A' ^? _AlphaLower) +-- Nothing +-- +-- >>> (upperlower #) <$> ('3' ^? _AlphaLower) +-- Nothing +upperlower :: + Iso' + AlphaUpper + AlphaLower +upperlower = + iso + (\(AlphaUpper c) -> AlphaLower (toLower c)) + (\(AlphaLower c) -> AlphaUpper (toUpper c)) + +-- | Isomorphism from lower to upper. +-- +-- >>> (lowerupper #) <$> ('A' ^? _AlphaUpper) +-- Just (AlphaLower 'a') +-- +-- >>> (lowerupper #) <$> ('a' ^? _AlphaUpper) +-- Nothing +-- +-- >>> (lowerupper #) <$> ('3' ^? _AlphaUpper) +-- Nothing +lowerupper :: + Iso' + AlphaLower + AlphaUpper +lowerupper = + from upperlower diff --git a/test/doctests.hs b/test/doctests.hs new file mode 100644 --- /dev/null +++ b/test/doctests.hs @@ -0,0 +1,32 @@ +module Main where + +import Build_doctests (deps) +import Control.Applicative +import Control.Monad +import Data.List +import System.Directory +import System.FilePath +import Test.DocTest + +main :: + IO () +main = + getSources >>= \sources -> doctest $ + "-isrc" + : "-idist/build/autogen" + : "-optP-include" + : "-optPdist/build/autogen/cabal_macros.h" + : "-hide-all-packages" + : map ("-package="++) deps ++ sources + +getSources :: IO [FilePath] +getSources = filter (isSuffixOf ".hs") <$> go "src" + where + go dir = do + (dirs, files) <- getFilesAndDirectories dir + (files ++) . concat <$> mapM go dirs + +getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath]) +getFilesAndDirectories dir = do + c <- map (dir ) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir + (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c