packages feed

foscam-filename (empty) → 0.0.1

raw patch · 15 files changed

+1108/−0 lines, 15 filesdep +QuickCheckdep +basedep +bifunctorsbuild-type:Customsetup-changed

Dependencies added: QuickCheck, base, bifunctors, digit, directory, doctest, filepath, lens, parsec, parsers, semigroupoids, semigroups, template-haskell

Files

+ LICENSE view
@@ -0,0 +1,27 @@+Copyright 2015 Tony Morris++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. 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.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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.
+ Setup.lhs view
@@ -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}
+ changelog view
@@ -0,0 +1,4 @@+0.0.1++* Initial version.+
+ foscam-filename.cabal view
@@ -0,0 +1,84 @@+name:               foscam-filename+version:            0.0.1+license:            BSD3+license-file:       LICENSE+author:             Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> <dibblego>+maintainer:         Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> <dibblego>+copyright:          Copyright (C) 2015 Tony Morris+synopsis:           Foscam File format+category:           Data+description:        +  Foscam File format++homepage:           https://github.com/tonymorris/foscam-filename+bug-reports:        https://github.com/tonymorris/foscam-filename+cabal-version:      >= 1.10+build-type:         Custom+extra-source-files: changelog++source-repository   head+  type:             git+  location:         git@github.com:tonymorris/foscam-filename.git++flag                small_base+  description:      Choose the new, split-up base package.++library+  default-language:+                    Haskell2010++  build-depends:+                      base          >= 4     && < 5+                    , semigroups    >= 0.17  && < 0.19+                    , semigroupoids >= 5.0   && < 5.1+                    , bifunctors    >= 5     && < 6.0+                    , lens          >= 4.0   && < 5+                    , parsers       >= 0.12  && < 0.13+                    , digit         >= 0.1.1 && < 0.2++  ghc-options:+                    -Wall++  default-extensions:+                    NoImplicitPrelude++  hs-source-dirs:+                    src++  exposed-modules:+                    Data.Foscam.File+                    Data.Foscam.File.Alias+                    Data.Foscam.File.AliasCharacter+                    Data.Foscam.File.Date+                    Data.Foscam.File.DeviceId+                    Data.Foscam.File.DeviceIdCharacter+                    Data.Foscam.File.Internal+                    Data.Foscam.File.Filename+                    Data.Foscam.File.ImageId+                    Data.Foscam.File.Time++test-suite doctests+  type:+                    exitcode-stdio-1.0++  main-is:+                    doctests.hs++  default-language:+                    Haskell2010++  build-depends:+                      base             >= 4     && < 5+                    , doctest          >= 0.9.7 && < 0.11+                    , filepath         >= 1.3   && < 1.5+                    , directory        >= 1.1   && < 1.3+                    , QuickCheck       >= 2.0   && < 3.0+                    , template-haskell >= 2.8   && < 3.0+                    , parsec           >= 3.1   && < 4.0++  ghc-options:+                    -Wall+                    -threaded++  hs-source-dirs:+                    test
+ src/Data/Foscam/File.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}++module Data.Foscam.File(+  module F+) where++import Data.Foscam.File.Alias as F+import Data.Foscam.File.AliasCharacter as F+import Data.Foscam.File.Date as F +import Data.Foscam.File.DeviceIdCharacter as F+import Data.Foscam.File.DeviceId as F+import Data.Foscam.File.ImageId as F+import Data.Foscam.File.Filename as F+import Data.Foscam.File.Time as F
+ src/Data/Foscam/File/Alias.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}++module Data.Foscam.File.Alias(+  Alias(..)+, AsAlias(..)+, AsAliasHead(..)+, AsAliasTail(..)+, alias+) where++import Control.Applicative(Applicative((<*>)), (<$>))+import Control.Category(Category(id))+import Control.Lens(Optic', Choice, Cons(_Cons), prism', lens, (^?), (#))+import Control.Monad(Monad)+import Data.Eq(Eq)+import Data.Foscam.File.AliasCharacter(AliasCharacter, AsAliasCharacter(_AliasCharacter), aliasCharacter)+import Data.Functor(Functor)+import Data.Maybe(Maybe(Nothing, Just))+import Data.Ord(Ord)+import Data.String(String)+import Data.Traversable(traverse)+import Prelude(Show)+import Text.Parser.Char(CharParsing)+import Text.Parser.Combinators(many, (<?>), try)++-- $setup+-- >>> import Text.Parsec++data Alias =+  Alias+    AliasCharacter+    [AliasCharacter]+  deriving (Eq, Ord, Show)++class AsAlias p f s where+  _Alias ::+    Optic' p f s Alias++instance AsAlias p f Alias where+  _Alias =+    id++instance (Choice p, Applicative f) => AsAlias p f String where+  _Alias =+    prism'+      (\(Alias h t) -> (_AliasCharacter #) <$> (h:t))+      (\s -> case s of +               [] -> +                 Nothing+               h:t ->+                 let ch = (^? _AliasCharacter)+                 in Alias <$> ch h <*> traverse ch t)++instance Cons Alias Alias AliasCharacter AliasCharacter where+  _Cons = +    prism'+      (\(h, Alias h' t) -> Alias h (h':t))+      (\(Alias h t) -> case t of +                         [] ->+                           Nothing+                         u:v ->+                           Just (h, Alias u v))++class AsAliasHead p f s where+  _AliasHead ::+    Optic' p f s AliasCharacter++instance AsAliasHead p f AliasCharacter where+  _AliasHead =+    id++instance (p ~ (->), Functor f) => AsAliasHead p f Alias where+  _AliasHead =+    lens+      (\(Alias h _) -> h)+      (\(Alias _ t) h -> Alias h t)++class AsAliasTail p f s where+  _AliasTail ::+    Optic' p f s [AliasCharacter]++instance AsAliasTail p f [AliasCharacter] where+  _AliasTail =+    id++instance (p ~ (->), Functor f) => AsAliasTail p f Alias where+  _AliasTail =+    lens+      (\(Alias _ t) -> t)+      (\(Alias h _) t -> Alias h t)++-- |+--+-- >>> parse alias "test" "abcdef"+-- Right (Alias (AliasCharacter 'a') [AliasCharacter 'b',AliasCharacter 'c',AliasCharacter 'd',AliasCharacter 'e',AliasCharacter 'f'])+-- +-- >>> parse alias "test" "abc123"+-- Right (Alias (AliasCharacter 'a') [AliasCharacter 'b',AliasCharacter 'c',AliasCharacter '1',AliasCharacter '2',AliasCharacter '3'])+-- +-- >>> parse alias "test" "abc*123"+-- Right (Alias (AliasCharacter 'a') [AliasCharacter 'b',AliasCharacter 'c'])+-- +-- >>> parse alias "test" "abc*"+-- Right (Alias (AliasCharacter 'a') [AliasCharacter 'b',AliasCharacter 'c'])+-- +-- >>> parse alias "test" ""+-- Left "test" (line 1, column 1):+-- unexpected end of input+-- expecting alias+alias ::+  (Monad f, CharParsing f) =>+  f Alias+alias =+  let a = try aliasCharacter+  in Alias <$> a <*> many a <?> "alias"
+ src/Data/Foscam/File/AliasCharacter.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}++module Data.Foscam.File.AliasCharacter (+  AliasCharacter+, AsAliasCharacter(..)+, aliasCharacter+) where++import Control.Applicative(Applicative(pure), (<$>))+import Control.Category(Category((.), id))+import Control.Lens(Optic', Choice, prism')+import Control.Monad(Monad(fail))+import Data.Char(Char)+import Data.Eq(Eq)+import Data.Foscam.File.Internal(boolj, charP)+import Data.List((++), notElem)+import Data.Ord(Ord)+import Prelude(Show)+import Text.Parser.Char(CharParsing)+import Text.Parser.Combinators((<?>))++-- $setup+-- >>> import Text.Parsec++newtype AliasCharacter = +  AliasCharacter Char+  deriving (Eq, Ord, Show)++class AsAliasCharacter p f s where+  _AliasCharacter ::+    Optic' p f s AliasCharacter++instance AsAliasCharacter p f AliasCharacter where+  _AliasCharacter =+    id++instance (Choice p, Applicative f) => AsAliasCharacter p f Char where+  _AliasCharacter =+    prism'+      (\(AliasCharacter c) -> c)+      ((AliasCharacter <$>) . boolj (`notElem` ['/', ':', '*', '?', '"', '<', '>', '(', ')']))++-- todo: _1 to _12 ??   ++-- |+--+-- >>> parse aliasCharacter "test" "2062"+-- Right (AliasCharacter '2')+-- +-- >>> parse aliasCharacter "test" "2"+-- Right (AliasCharacter '2')+-- +-- >>> parse aliasCharacter "test" "abc"+-- Right (AliasCharacter 'a')+-- +-- >>> parse aliasCharacter "test" "*"+-- Left "test" (line 1, column 2):+-- not an alias character: *+-- +-- >>> parse aliasCharacter "test" "<"+-- Left "test" (line 1, column 2):+-- not an alias character: <+-- +-- >>> parse aliasCharacter "test" ""+-- Left "test" (line 1, column 1):+-- unexpected end of input+-- expecting alias character+aliasCharacter ::+  (Monad f, CharParsing f) =>+  f AliasCharacter+aliasCharacter =+  charP (fail . ("not an alias character: " ++) . pure) _AliasCharacter <?> "alias character"+
+ src/Data/Foscam/File/Date.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}++module Data.Foscam.File.Date(+  Date(..)+, AsDate(..)+, date+) where++import Control.Applicative(Applicative((<*>)), (<$>))+import Control.Category(Category(id))+import Control.Lens(Optic', Choice, prism', (^?), (#))+import Control.Monad(Monad)+import Data.Digit(Digit, digitC)+import Data.Eq(Eq)+import Data.Foscam.File.Internal(digitCharacter)+import Data.Maybe(Maybe(Nothing))+import Data.Ord(Ord)+import Data.String(String)+import Text.Parser.Char(CharParsing)+import Text.Parser.Combinators((<?>))+import Prelude(Show)++-- $setup+-- >>> import Text.Parsec++data Date =+  Date+    Digit+    Digit+    Digit+    Digit+    Digit+    Digit+    Digit+    Digit+  deriving (Eq, Ord, Show)+  +class AsDate p f s where+  _Date ::+    Optic' p f s Date++instance AsDate p f Date where+  _Date =+    id++instance (Choice p, Applicative f) => AsDate p f String where+  _Date =+    prism'+      (\(Date d01 d02 d03 d04 d05 d06 d07 d08) -> (digitC #) <$> [d01, d02, d03, d04, d05, d06, d07, d08])+      (\s -> case s of+               [c01, c02, c03, c04, c05, c06, c07, c08] ->+                 let f = (^? digitC)+                 in Date <$>+                      f c01 <*>+                      f c02 <*>+                      f c03 <*>+                      f c04 <*>+                      f c05 <*>+                      f c06 <*>+                      f c07 <*>+                      f c08+               _ ->+                 Nothing)++-- |+-- +-- >>> parse date "test" "20140508"+-- Right (Date 2 0 1 4 0 5 0 8)+-- +-- >>> parse date "test" "20140508abc"+-- Right (Date 2 0 1 4 0 5 0 8)+-- +-- >>> parse date "test" "201405"+-- Left "test" (line 1, column 7):+-- unexpected end of input+-- expecting digit+-- +-- >>> parse date "test" "201405a9"+-- Left "test" (line 1, column 8):+-- not a digit: a+-- +-- >>> parse date "test" ""+-- Left "test" (line 1, column 1):+-- unexpected end of input+-- expecting date+date ::+  (Monad f, CharParsing f) =>+  f Date+date =+  Date <$>+    digitCharacter <*>+    digitCharacter <*>+    digitCharacter <*>+    digitCharacter <*>+    digitCharacter <*>+    digitCharacter <*>+    digitCharacter <*>+    digitCharacter <?> "date"
+ src/Data/Foscam/File/DeviceId.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}++module Data.Foscam.File.DeviceId(+  DeviceId(..)+, AsDeviceId(..)+, deviceId+) where++import Control.Applicative(Applicative((<*>)), (<$>))+import Control.Category(id)+import Control.Lens(Optic', Choice, prism', (^?), ( # ))+import Control.Monad(Monad)+import Data.Eq(Eq)+import Data.Foscam.File.DeviceIdCharacter+import Data.Functor(fmap)+import Data.Maybe(Maybe(Nothing))+import Data.Ord(Ord)+import Data.String(String)+import Text.Parser.Char(CharParsing)+import Text.Parser.Combinators((<?>))+import Prelude(Show)+++-- $setup+-- >>> import Text.Parsec++data DeviceId =+  DeviceId+    DeviceIdCharacter+    DeviceIdCharacter+    DeviceIdCharacter+    DeviceIdCharacter+    DeviceIdCharacter+    DeviceIdCharacter+    DeviceIdCharacter+    DeviceIdCharacter+    DeviceIdCharacter+    DeviceIdCharacter+    DeviceIdCharacter+    DeviceIdCharacter+  deriving (Eq, Ord, Show)++class AsDeviceId p f s where+  _DeviceId ::+    Optic' p f s DeviceId++instance AsDeviceId p f DeviceId where+  _DeviceId =+    id++instance (Choice p, Applicative f) => AsDeviceId p f String where+  _DeviceId =+    prism'+      (\(DeviceId d01 d02 d03 d04 d05 d06 d07 d08 d09 d10 d11 d12) -> fmap (_DeviceIdCharacter #) [d01, d02, d03, d04, d05, d06, d07, d08, d09, d10, d11, d12])+      (\s -> case s of+               [c01, c02, c03, c04, c05, c06, c07, c08, c09, c10, c11, c12] ->+                 let f = (^? _DeviceIdCharacter)+                 in DeviceId <$>+                      f c01 <*>+                      f c02 <*>+                      f c03 <*>+                      f c04 <*>+                      f c05 <*>+                      f c06 <*>+                      f c07 <*>+                      f c08 <*>+                      f c09 <*>+                      f c10 <*>+                      f c11 <*>+                      f c12+               _ ->+                 Nothing)++-- |+--+-- >>> parse deviceId "test" "AB0934233DEF"+-- Right (DeviceId (DeviceIdCharacter 'A') (DeviceIdCharacter 'B') (DeviceIdCharacter '0') (DeviceIdCharacter '9') (DeviceIdCharacter '3') (DeviceIdCharacter '4') (DeviceIdCharacter '2') (DeviceIdCharacter '3') (DeviceIdCharacter '3') (DeviceIdCharacter 'D') (DeviceIdCharacter 'E') (DeviceIdCharacter 'F'))+-- +-- >>> parse deviceId "test" "AB0934233DEFabc"+-- Right (DeviceId (DeviceIdCharacter 'A') (DeviceIdCharacter 'B') (DeviceIdCharacter '0') (DeviceIdCharacter '9') (DeviceIdCharacter '3') (DeviceIdCharacter '4') (DeviceIdCharacter '2') (DeviceIdCharacter '3') (DeviceIdCharacter '3') (DeviceIdCharacter 'D') (DeviceIdCharacter 'E') (DeviceIdCharacter 'F'))+-- +-- >>> parse deviceId "test" "AB0934233DX"+-- Left "test" (line 1, column 12):+-- not a device ID character: X+-- +-- >>> parse deviceId "test" "AB0934233DEf"+-- Left "test" (line 1, column 13):+-- not a device ID character: f+-- +-- >>> parse deviceId "test" ""+-- Left "test" (line 1, column 1):+-- unexpected end of input+-- expecting device ID+deviceId ::+  (Monad f, CharParsing f) =>+  f DeviceId+deviceId =+  DeviceId <$>+    deviceIdCharacter <*>+    deviceIdCharacter <*>+    deviceIdCharacter <*>+    deviceIdCharacter <*>+    deviceIdCharacter <*>+    deviceIdCharacter <*>+    deviceIdCharacter <*>+    deviceIdCharacter <*>+    deviceIdCharacter <*>+    deviceIdCharacter <*>+    deviceIdCharacter <*>+    deviceIdCharacter <?> "device ID"
+ src/Data/Foscam/File/DeviceIdCharacter.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}++module Data.Foscam.File.DeviceIdCharacter(+  DeviceIdCharacter+, AsDeviceIdCharacter(..)+, deviceIdCharacter+) where++import Control.Applicative(Applicative(pure))+import Control.Category(id, (.))+import Control.Lens(Optic', Choice, prism')+import Control.Monad(Monad(fail))+import Data.Char(Char)+import Data.Eq(Eq)+import Data.Functor(fmap)+import Data.Foscam.File.Internal(boolj, charP)+import Data.List(elem, (++))+import Data.Ord(Ord)+import Text.Parser.Char(CharParsing)+import Text.Parser.Combinators((<?>))+import Prelude(Show)+++-- $setup+-- >>> import Text.Parsec++newtype DeviceIdCharacter = +  DeviceIdCharacter Char+  deriving (Eq, Ord, Show)++class AsDeviceIdCharacter p f s where+  _DeviceIdCharacter ::+    Optic' p f s DeviceIdCharacter++instance AsDeviceIdCharacter p f DeviceIdCharacter where+  _DeviceIdCharacter =+    id++instance (Choice p, Applicative f) => AsDeviceIdCharacter p f Char where+  _DeviceIdCharacter =+    prism'+      (\(DeviceIdCharacter c) -> c)+      (fmap DeviceIdCharacter . boolj (`elem` (['A'..'F'] ++ ['0'..'9'])))++-- |+--+-- >>> parse deviceIdCharacter "test" "A"+-- Right (DeviceIdCharacter 'A')+-- +-- >>> parse deviceIdCharacter "test" "0"+-- Right (DeviceIdCharacter '0')+-- +-- >>> parse deviceIdCharacter "test" "0abc"+-- Right (DeviceIdCharacter '0')+-- +-- >>> parse deviceIdCharacter "test" "a"+-- Left "test" (line 1, column 2):+-- not a device ID character: a+-- +-- >>> parse deviceIdCharacter "test" "G"+-- Left "test" (line 1, column 2):+-- not a device ID character: G+--+-- >>> parse deviceIdCharacter "test" ""+-- Left "test" (line 1, column 1):+-- unexpected end of input+-- expecting device ID character    +deviceIdCharacter ::+  (Monad f, CharParsing f) =>+  f DeviceIdCharacter+deviceIdCharacter =+  charP (fail . ("not a device ID character: " ++) . pure) _DeviceIdCharacter <?> "device ID character"
+ src/Data/Foscam/File/Filename.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}++module Data.Foscam.File.Filename(+  Filename(..)+, AsFilename(..)+, filename+) where++import Control.Applicative(Applicative((<*>)), (<*), (<$>))+import Control.Category(id)+import Control.Lens(Optic', lens)+import Control.Monad(Monad)+import Data.Digit(Digit)+import Data.Eq(Eq)+import Data.Foscam.File.Internal(digitCharacter)+import Data.Foscam.File.Alias(AsAlias(_Alias), Alias, alias)+import Data.Foscam.File.Date(AsDate(_Date), Date, date)+import Data.Foscam.File.DeviceId(AsDeviceId(_DeviceId), DeviceId, deviceId)+import Data.Foscam.File.ImageId(AsImageId(_ImageId), ImageId, imageId)+import Data.Foscam.File.Time(AsTime(_Time), Time, time)+import Data.Functor(Functor)+import Data.Ord(Ord)+import Text.Parser.Char(CharParsing, char, string)+import Text.Parser.Combinators((<?>))+import Prelude(Show)++-- $setup+-- >>> import Text.Parsec++data Filename =+  Filename+    DeviceId+    Alias+    Digit+    Date+    Time+    ImageId+  deriving (Eq, Ord, Show)++class AsFilename p f s where+  _Filename ::+    Optic' p f s Filename++instance AsFilename p f Filename where+  _Filename =+    id++instance (p ~ (->), Functor f) => AsDeviceId p f Filename where+  _DeviceId =+    lens+      (\(Filename i _ _ _ _ _) -> i)+      (\(Filename _ a x d t m) i -> Filename i a x d t m)++instance (p ~ (->), Functor f) => AsAlias p f Filename where+  _Alias =+    lens+      (\(Filename _ a _ _ _ _) -> a)+      (\(Filename i _ x d t m) a -> Filename i a x d t m)++instance (p ~ (->), Functor f) => AsDate p f Filename where+  _Date =+    lens+      (\(Filename _ _ _ d _ _) -> d)+      (\(Filename i a x _ t m) d -> Filename i a x d t m)++instance (p ~ (->), Functor f) => AsTime p f Filename where+  _Time =+    lens+      (\(Filename _ _ _ _ t _) -> t)+      (\(Filename i a x d _ m) t -> Filename i a x d t m)++instance (p ~ (->), Functor f) => AsImageId p f Filename where+  _ImageId =+    lens+      (\(Filename _ _ _ _ _ m) -> m)+      (\(Filename i a x d t _) m -> Filename i a x d t m)++-- |+--+-- >>> parse Filename "test" "00626E44C831(house)_1_20150209134121_2629.jpg"+-- Right (Filename (DeviceId (DeviceIdCharacter '0') (DeviceIdCharacter '0') (DeviceIdCharacter '6') (DeviceIdCharacter '2') (DeviceIdCharacter '6') (DeviceIdCharacter 'E') (DeviceIdCharacter '4') (DeviceIdCharacter '4') (DeviceIdCharacter 'C') (DeviceIdCharacter '8') (DeviceIdCharacter '3') (DeviceIdCharacter '1')) (Alias (AliasCharacter 'h') [AliasCharacter 'o',AliasCharacter 'u',AliasCharacter 's',AliasCharacter 'e']) 1 (Date 2 0 1 5 0 2 0 9) (Time 1 3 4 1 2 1) (ImageId 2 [6,2,9]))+--+-- >>> parse Filename "test" "00626E44C829(garage)_1_20140313234556_2660.jpg"+-- Right (Filename (DeviceId (DeviceIdCharacter '0') (DeviceIdCharacter '0') (DeviceIdCharacter '6') (DeviceIdCharacter '2') (DeviceIdCharacter '6') (DeviceIdCharacter 'E') (DeviceIdCharacter '4') (DeviceIdCharacter '4') (DeviceIdCharacter 'C') (DeviceIdCharacter '8') (DeviceIdCharacter '2') (DeviceIdCharacter '9')) (Alias (AliasCharacter 'g') [AliasCharacter 'a',AliasCharacter 'r',AliasCharacter 'a',AliasCharacter 'g',AliasCharacter 'e']) 1 (Date 2 0 1 4 0 3 1 3) (Time 2 3 4 5 5 6) (ImageId 2 [6,6,0]))+--+-- >>> parse Filename "test" "00626E44C82x(garage)_1_20140313234556_2660.jpg"+-- Left "test" (line 1, column 13):+-- not a device ID character: x+--+-- >>> parse Filename "test" "00626E44C829(gara*ge)_1_20140313234556_2660.jpg"+-- Left "test" (line 1, column 19):+-- not an alias character: *+--+-- >>> parse Filename "test" "00626E44C829(garage) 1_20140313234556_2660.jpg"+-- Left "test" (line 1, column 20):+-- unexpected " "+-- expecting ")_"+--+-- >>> parse Filename "test" "00626E44C829(garage)_x_20140313234556_2660.jpg"+-- Left "test" (line 1, column 23):+-- not a digit: x+--+-- >>> parse Filename "test" "00626E44C829(garage)_1 20140313234556_2660.jpg"+-- Left "test" (line 1, column 23):+-- unexpected " "+-- expecting "_"+--+-- >>> parse Filename "test" "00626E44C829(garage)_1_x0140313234556_2660.jpg"+-- Left "test" (line 1, column 25):+-- not a digit: x+filename ::+  (Monad f, CharParsing f) =>+  f Filename+filename =+  Filename <$>+    deviceId <*+    char '(' <*>+    alias <*+    string ")_" <*>+    digitCharacter <*+    char '_' <*>+    date <*>+    time <*+    char '_' <*>+    imageId <*+    string ".jpg" <?> "file"
+ src/Data/Foscam/File/ImageId.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}++module Data.Foscam.File.ImageId(+  ImageId(..)+, AsImageId(..)+, imageId+) where++import Control.Applicative(Applicative((<*>)), (<$>))+import Control.Category(id)+import Control.Lens(Cons(_Cons), Optic', Choice, prism', lens, (^?), ( # ))+import Control.Monad(Monad)+import Data.Digit(Digit, digitC)+import Data.Eq(Eq)+import Data.Foscam.File.Internal(digitCharacter)+import Data.Functor(Functor)+import Data.Maybe(Maybe(Nothing, Just))+import Data.Ord(Ord)+import Data.String(String)+import Data.Traversable(traverse)+import Text.Parser.Char(CharParsing)+import Text.Parser.Combinators((<?>), try, many)+import Prelude(Show)++-- $setup+-- >>> import Text.Parsec++data ImageId =+  ImageId+    Digit+    [Digit]+  deriving (Eq, Ord, Show)++class AsImageId p f s where+  _ImageId ::+    Optic' p f s ImageId++instance AsImageId p f ImageId where+  _ImageId =+    id++instance (Choice p, Applicative f) => AsImageId p f String where+  _ImageId =+    prism'+      (\(ImageId h t) -> (digitC #) <$> (h:t))+      (\s -> case s of +               [] -> +                 Nothing+               h:t ->+                 let ch = (^? digitC)+                 in ImageId <$> ch h <*> traverse ch t)++instance Cons ImageId ImageId Digit Digit where+  _Cons = +    prism'+      (\(h, ImageId h' t) -> ImageId h (h':t))+      (\(ImageId h t) -> case t of +                         [] ->+                           Nothing+                         u:v ->+                           Just (h, ImageId u v))++class AsImageIdHead p f s where+  _ImageIdHead ::+    Optic' p f s Digit++instance AsImageIdHead p f Digit where+  _ImageIdHead =+    id++instance (p ~ (->), Functor f) => AsImageIdHead p f ImageId where+  _ImageIdHead =+    lens+      (\(ImageId h _) -> h)+      (\(ImageId _ t) h -> ImageId h t)++class AsImageIdTail p f s where+  _ImageIdTail ::+    Optic' p f s [Digit]++instance AsImageIdTail p f [Digit] where+  _ImageIdTail =+    id++instance (p ~ (->), Functor f) => AsImageIdTail p f ImageId where+  _ImageIdTail =+    lens+      (\(ImageId _ t) -> t)+      (\(ImageId h _) t -> ImageId h t)++-- |+--+-- >>> parse imageId "test" "2062"+-- Right (ImageId 2 [0,6,2])+--+-- >>> parse imageId "test" "2"+-- Right (ImageId 2 [])+--+-- >>> parse imageId "test" "a"+-- Left "test" (line 1, column 2):+-- expecting image ID+-- not a digit: a+--+-- >>> parse imageId "test" ""+-- Left "test" (line 1, column 1):+-- unexpected end of input+-- expecting image ID+imageId ::+  (Monad f, CharParsing f) =>+  f ImageId+imageId =+  let i = try digitCharacter+  in ImageId <$> i <*> many i <?> "image ID"
+ src/Data/Foscam/File/Internal.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Foscam.File.Internal(+  charP+, digitCharacter+, boolj+) where++import Control.Applicative(pure)+import Control.Category((.))+import Control.Monad(Monad((>>=), fail))+import Data.Bool(bool, Bool)+import Data.Char(Char)+import Data.Digit(Digit, digitC)+import Data.Maybe(Maybe(Nothing, Just), maybe)+import Data.Monoid(First, (<>))+import Control.Lens(Getting, (^?))+import Text.Parser.Char(CharParsing, anyChar)+import Text.Parser.Combinators((<?>))++charP :: +  (Monad f, CharParsing f) =>+  (Char -> f a)+  -> Getting (First a) Char a+  -> f a+charP fl p =+  anyChar >>= \c -> maybe (fl c) pure (c ^? p) ++digitCharacter ::+  (Monad f, CharParsing f) =>+  f Digit+digitCharacter =+  charP (fail . ("not a digit: " <>) . pure) digitC <?> "digit"++boolj ::+  (a -> Bool)+  -> a+  -> Maybe a+boolj p x = +  bool Nothing (Just x) (p x)
+ src/Data/Foscam/File/Time.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}++module Data.Foscam.File.Time(+  Time(..)+, AsTime(..)+, time+) where++import Control.Applicative(Applicative((<*>)), (<$>))+import Control.Category(id)+import Control.Lens(Optic', Choice, prism', (^?), ( # ))+import Control.Monad(Monad)+import Data.Digit(Digit, digitC)+import Data.Eq(Eq)+import Data.Foscam.File.Internal(digitCharacter)+import Data.Maybe(Maybe(Nothing))+import Data.Ord(Ord)+import Data.String(String)+import Text.Parser.Char(CharParsing)+import Text.Parser.Combinators((<?>))+import Prelude(Show)++-- $setup+-- >>> import Text.Parsec++data Time =+  Time+    Digit+    Digit+    Digit+    Digit+    Digit+    Digit+  deriving (Eq, Ord, Show)++class AsTime p f s where+  _Time ::+    Optic' p f s Time++instance AsTime p f Time where+  _Time =+    id++instance (Choice p, Applicative f) => AsTime p f String where+  _Time =+    prism'+      (\(Time d01 d02 d03 d04 d05 d06) -> (digitC #) <$> [d01, d02, d03, d04, d05, d06])+      (\s -> case s of+               [c01, c02, c03, c04, c05, c06] ->+                 let f = (^? digitC)+                 in Time <$>+                      f c01 <*>+                      f c02 <*>+                      f c03 <*>+                      f c04 <*>+                      f c05 <*>+                      f c06+               _ ->+                 Nothing)++-- |+--+-- >>> parse time "test" "134122"+-- Right (Time 1 3 4 1 2 2)+--+-- >>> parse time "test" "134122abc"+-- Right (Time 1 3 4 1 2 2)+--+-- >>> parse time "test" "1341"+-- Left "test" (line 1, column 5):+-- unexpected end of input+-- expecting digit+time ::+  (Monad f, CharParsing f) =>+  f Time+time =+  Time <$>+    digitCharacter <*>+    digitCharacter <*>+    digitCharacter <*>+    digitCharacter <*>+    digitCharacter <*>+    digitCharacter <?> "time"
+ test/doctests.hs view
@@ -0,0 +1,85 @@+module Main where++import Control.Applicative+import Prelude+import Build_doctests (deps)+import Control.Monad+import Data.List+import Data.Monoid+import System.Directory+import System.FilePath+import System.IO+import Test.DocTest++main ::+  IO ()+main =+  getSources >>= \sources ->+    forM_ (preferredOrderFirst sources) $ \source -> do+      hPutStrLn stderr $ "Testing " <> source+      doctest $+          "-isrc"+        : "-idist/build/autogen"+        : "-optP-include"+        : "-optPdist/build/autogen/cabal_macros.h"+        : "-hide-all-packages"+        : map ("-package="++) deps ++ [source]++sourceDirectories ::+  [FilePath]+sourceDirectories =+  [+    "src"+  ]++preferredOrderFirst :: [FilePath] -> [FilePath]+preferredOrderFirst sources =+     filter (`elem`    sources       ) preferredOrder+  <> filter (`notElem` preferredOrder) sources++-- If you find the tests are running slowly.+-- Comment out the Modules you have completed+-- in the list below.+preferredOrder :: [String]+preferredOrder = map (\f -> "src/Course" </> f <.> "hs") [+      "List"+    , "Functor"+    , "Apply"+    , "Applicative"+    , "Bind"+    , "Monad"+    , "FileIO"+    , "State"+    , "StateT"+    , "Extend"+    , "Comonad"+    , "Compose"+    , "Traversable"+    , "ListZipper"+    , "Parser"+    , "MoreParser"+    , "JsonParser"+    , "Interactive"+    , "Anagrams"+    , "FastAnagrams"+    , "Cheque"+    ]++isSourceFile ::+  FilePath+  -> Bool+isSourceFile p =+  and [takeFileName p /= "Setup.hs", isSuffixOf ".hs" p]++getSources :: IO [FilePath]+getSources =+  liftM (filter isSourceFile . concat) (mapM go sourceDirectories)+    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